diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/fortran/ChangeLog | 162 | ||||
| -rw-r--r-- | gcc/fortran/dump-parse-tree.c | 100 | ||||
| -rw-r--r-- | gcc/fortran/frontend-passes.c | 20 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 89 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 21 | ||||
| -rw-r--r-- | gcc/fortran/match.h | 7 | ||||
| -rw-r--r-- | gcc/fortran/module.c | 110 | ||||
| -rw-r--r-- | gcc/fortran/openmp.c | 730 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 84 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 15 | ||||
| -rw-r--r-- | gcc/fortran/st.c | 8 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 1 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 8 | ||||
| -rw-r--r-- | gcc/fortran/trans-openmp.c | 627 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/trans.c | 6 | ||||
| -rw-r--r-- | gcc/gimplify.c | 21 | ||||
| -rw-r--r-- | gcc/omp-low.c | 20 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 | 19 | ||||
| -rw-r--r-- | gcc/tree-nested.c | 2 | ||||
| -rw-r--r-- | gcc/tree.c | 9 | ||||
| -rw-r--r-- | gcc/tree.h | 3 |
24 files changed, 1909 insertions, 173 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 083aca3fe5c..f3cb5f7510e 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,18 @@ +2014-05-11 Jakub Jelinek <jakub@redhat.com> + + * tree.h (OMP_CLAUSE_LINEAR_STMT): Define. + * tree.c (omp_clause_num_ops): Increase OMP_CLAUSE_LINEAR + number of operands to 3. + (walk_tree_1): Walk all operands of OMP_CLAUSE_LINEAR. + * tree-nested.c (convert_nonlocal_omp_clauses, + convert_local_omp_clauses): Handle OMP_CLAUSE_DEPEND. + * gimplify.c (gimplify_scan_omp_clauses): Handle + OMP_CLAUSE_LINEAR_STMT. + * omp-low.c (lower_rec_input_clauses): Fix typo. + (maybe_add_implicit_barrier_cancel, lower_omp_1): Add + cast between Fortran boolean_type_node and C _Bool if + needed. + 2014-05-11 Richard Sandiford <rdsandiford@googlemail.com> PR tree-optimization/61136 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 182563cb848..3f2f787cf21 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,165 @@ +2014-05-11 Jakub Jelinek <jakub@redhat.com> + + * gfortran.h (gfc_statement): Add ST_OMP_CANCEL, + ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, + ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and + ST_OMP_DECLARE_SIMD. + (gfc_omp_namelist): New typedef. + (gfc_get_omp_namelist): Define. + (OMP_LIST_UNIFORM, OMP_LIST_ALIGNED, OMP_LIST_LINEAR, + OMP_LIST_DEPEND_IN, OMP_LIST_DEPEND_OUT): New clause list kinds. + (gfc_omp_proc_bind_kind, gfc_omp_cancel_kind): New enums. + (gfc_omp_clauses): Change type of lists to gfc_omp_namelist *. + Add inbranch, notinbranch, cancel, proc_bind, safelen_expr and + simdlen_expr fields. + (gfc_omp_declare_simd): New typedef. + (gfc_get_omp_declare_simd): Define. + (gfc_namespace): Add omp_declare_simd field. + (gfc_exec_op): Add EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD and + EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_MASK, GFC_OMP_ATOMIC_SEQ_CST + and GFC_OMP_ATOMIC_SWAP. + (gfc_code): Change type of omp_namelist field to gfc_omp_namelist *. + (gfc_free_omp_namelist, gfc_free_omp_declare_simd, + gfc_free_omp_declare_simd_list, gfc_resolve_omp_declare_simd): New + prototypes. + * trans-stmt.h (gfc_trans_omp_declare_simd): New prototype. + * symbol.c (gfc_free_namespace): Call gfc_free_omp_declare_simd. + * openmp.c (gfc_free_omp_clauses): Free safelen_expr and + simdlen_expr. Use gfc_free_omp_namelist instead of + gfc_free_namelist. + (gfc_free_omp_declare_simd, gfc_free_omp_declare_simd_list): New + functions. + (gfc_match_omp_variable_list): Add end_colon, headp and + allow_sections arguments. Handle parsing of array sections. + Use *omp_namelist* instead of *namelist* data structure and + functions/macros. Allow termination at : character. + (OMP_CLAUSE_ALIGNED, OMP_CLAUSE_DEPEND, OMP_CLAUSE_INBRANCH, + OMP_CLAUSE_LINEAR, OMP_CLAUSE_NOTINBRANCH, OMP_CLAUSE_PROC_BIND, + OMP_CLAUSE_SAFELEN, OMP_CLAUSE_SIMDLEN, OMP_CLAUSE_UNIFORM): Define. + (gfc_match_omp_clauses): Change first and needs_space variables + into arguments with default values. Parse inbranch, notinbranch, + proc_bind, safelen, simdlen, uniform, linear, aligned and + depend clauses. + (OMP_PARALLEL_CLAUSES): Add OMP_CLAUSE_PROC_BIND. + (OMP_DECLARE_SIMD_CLAUSES, OMP_SIMD_CLAUSES): Define. + (OMP_TASK_CLAUSES): Add OMP_CLAUSE_DEPEND. + (gfc_match_omp_do_simd): New function. + (gfc_match_omp_flush): Use *omp_namelist* instead of *namelist* + data structure and functions/macros. + (gfc_match_omp_simd, gfc_match_omp_declare_simd, + gfc_match_omp_parallel_do_simd): New functions. + (gfc_match_omp_atomic): Handle seq_cst clause. Handle atomic swap. + (gfc_match_omp_taskgroup, gfc_match_omp_cancel_kind, + gfc_match_omp_cancel, gfc_match_omp_cancellation_point): New + functions. + (resolve_omp_clauses): Add where, omp_clauses and ns arguments. + Use *omp_namelist* instead of *namelist* data structure and + functions/macros. Resolve uniform, aligned, linear, depend, + safelen and simdlen clauses. + (resolve_omp_atomic): Adjust for GFC_OMP_ATOMIC_{MASK,SEQ_CST,SWAP} + addition, recognize atomic swap. + (gfc_resolve_omp_parallel_blocks): Use gfc_omp_namelist instead + of gfc_namelist. Handle EXEC_OMP_PARALLEL_DO_SIMD the same as + EXEC_OMP_PARALLEL_DO. + (gfc_resolve_do_iterator): Use *omp_namelist* instead of *namelist* + data structure and functions/macros. + (resolve_omp_do): Likewise. Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_resolve_omp_directive): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD and EXEC_OMP_CANCEL. Adjust + resolve_omp_clauses caller. + (gfc_resolve_omp_declare_simd): New function. + * parse.c (decode_omp_directive): Parse cancellation point, cancel, + declare simd, end do simd, end simd, end parallel do simd, + end taskgroup, parallel do simd, simd and taskgroup directives. + (case_executable): Add ST_OMP_CANCEL and ST_OMP_CANCELLATION_POINT. + (case_exec_markers): Add ST_OMP_TASKGROUP, case ST_OMP_SIMD, + ST_OMP_DO_SIMD and ST_OMP_PARALLEL_DO_SIMD. + (case_decl): Add ST_OMP_DECLARE_SIMD. + (gfc_ascii_statement): Handle ST_OMP_CANCEL, + ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, + ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and + ST_OMP_DECLARE_SIMD. + (parse_omp_do): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD and + ST_OMP_PARALLEL_DO_SIMD. + (parse_omp_atomic): Adjust for GFC_OMP_ATOMIC_* additions. + (parse_omp_structured_block): Handle ST_OMP_TASKGROUP and + ST_OMP_PARALLEL_DO_SIMD. + (parse_executable): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD and ST_OMP_TASKGROUP. + * trans-decl.c (gfc_get_extern_function_decl, + gfc_create_function_decl): Call gfc_trans_omp_declare_simd if + needed. + * frontend-passes.c (gfc_code_walker): Handle EXEC_OMP_SIMD, + EXEC_OMP_DO_SIMD and EXEC_OMP_PARALLEL_DO_SIMD. Walk + safelen_expr and simdlen_expr. Walk expressions in gfc_omp_namelist + of depend, aligned and linear clauses. + * match.c (match_exit_cycle): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD + and EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_free_omp_namelist): New function. + * dump-parse-tree.c (show_namelist): Removed. + (show_omp_namelist): New function. + (show_omp_node): Handle OpenMP 4.0 additions. + (show_code_node): Handle EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_DO_SIMD, EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and + EXEC_OMP_TASKGROUP. + * match.h (gfc_match_omp_cancel, gfc_match_omp_cancellation_point, + gfc_match_omp_declare_simd, gfc_match_omp_do_simd, + gfc_match_omp_parallel_do_simd, gfc_match_omp_simd, + gfc_match_omp_taskgroup): New prototypes. + * trans-openmp.c (gfc_trans_omp_variable): Add declare_simd + argument, handle it. Allow current_function_decl to be NULL. + (gfc_trans_omp_variable_list): Add declare_simd argument, pass + it through to gfc_trans_omp_variable and disregard whether + sym is referenced if declare_simd is true. Work on gfc_omp_namelist + instead of gfc_namelist. + (gfc_trans_omp_reduction_list): Work on gfc_omp_namelist instead of + gfc_namelist. Adjust gfc_trans_omp_variable caller. + (gfc_trans_omp_clauses): Add declare_simd argument, pass it through + to gfc_trans_omp_variable{,_list} callers. Work on gfc_omp_namelist + instead of gfc_namelist. Handle inbranch, notinbranch, safelen, + simdlen, depend, uniform, linear, proc_bind and aligned clauses. + Handle cancel kind. + (gfc_trans_omp_atomic): Handle seq_cst clause, handle atomic swap, + adjust for GFC_OMP_ATOMIC_* changes. + (gfc_trans_omp_cancel, gfc_trans_omp_cancellation_point): New + functions. + (gfc_trans_omp_do): Add op argument, handle simd translation into + generic. + (GFC_OMP_SPLIT_SIMD, GFC_OMP_SPLIT_DO, GFC_OMP_SPLIT_PARALLEL, + GFC_OMP_SPLIT_NUM, GFC_OMP_MASK_SIMD, GFC_OMP_MASK_DO, + GFC_OMP_MASK_PARALLEL): New. + (gfc_split_omp_clauses, gfc_trans_omp_do_simd): New functions. + (gfc_trans_omp_parallel_do): Rework to use gfc_split_omp_clauses. + (gfc_trans_omp_parallel_do_simd, gfc_trans_omp_taskgroup): New + functions. + (gfc_trans_omp_directive): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + Adjust gfc_trans_omp_do caller. + (gfc_trans_omp_declare_simd): New function. + * st.c (gfc_free_statement): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + For EXEC_OMP_FLUSH call gfc_free_omp_namelist instead of + gfc_free_namelist. + * module.c (omp_declare_simd_clauses): New variable. + (mio_omp_declare_simd): New function. + (mio_symbol): Call it. + * trans.c (trans_code): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + * resolve.c (gfc_resolve_blocks): Handle EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + (resolve_code): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + (resolve_types): Call gfc_resolve_omp_declare_simd. + 2014-05-11 Tobias Burnus <burnus@net-b.de> * trans-intrinsic.c (gfc_build_builtin_function_decls): diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index b1343bc2a86..b5d2537a083 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1016,11 +1016,19 @@ show_code (int level, gfc_code *c) } static void -show_namelist (gfc_namelist *n) +show_omp_namelist (gfc_omp_namelist *n) { - for (; n->next; n = n->next) - fprintf (dumpfile, "%s,", n->sym->name); - fprintf (dumpfile, "%s", n->sym->name); + for (; n; n = n->next) + { + fprintf (dumpfile, "%s", n->sym->name); + if (n->expr) + { + fputc (':', dumpfile); + show_expr (n->expr); + } + if (n->next) + fputc (',', dumpfile); + } } /* Show a single OpenMP directive node and everything underneath it @@ -1036,18 +1044,24 @@ show_omp_node (int level, gfc_code *c) { case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; case EXEC_OMP_BARRIER: name = "BARRIER"; break; + 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_DO: name = "DO"; break; + case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break; case EXEC_OMP_MASTER: name = "MASTER"; break; case EXEC_OMP_ORDERED: name = "ORDERED"; break; case EXEC_OMP_PARALLEL: name = "PARALLEL"; break; case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break; + case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break; case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break; case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break; case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; + case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; case EXEC_OMP_TASK: name = "TASK"; break; + case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break; case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break; case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; @@ -1057,11 +1071,16 @@ show_omp_node (int level, gfc_code *c) fprintf (dumpfile, "!$OMP %s", name); switch (c->op) { + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: @@ -1076,7 +1095,7 @@ show_omp_node (int level, gfc_code *c) if (c->ext.omp_namelist) { fputs (" (", dumpfile); - show_namelist (c->ext.omp_namelist); + show_omp_namelist (c->ext.omp_namelist); fputc (')', dumpfile); } return; @@ -1091,6 +1110,23 @@ show_omp_node (int level, gfc_code *c) { int list_type; + switch (omp_clauses->cancel) + { + case OMP_CANCEL_UNKNOWN: + break; + case OMP_CANCEL_PARALLEL: + fputs (" PARALLEL", dumpfile); + break; + case OMP_CANCEL_SECTIONS: + fputs (" SECTIONS", dumpfile); + break; + case OMP_CANCEL_DO: + fputs (" DO", dumpfile); + break; + case OMP_CANCEL_TASKGROUP: + fputs (" TASKGROUP", dumpfile); + break; + } if (omp_clauses->if_expr) { fputs (" IF(", dumpfile); @@ -1156,7 +1192,7 @@ show_omp_node (int level, gfc_code *c) if (omp_clauses->lists[list_type] != NULL && list_type != OMP_LIST_COPYPRIVATE) { - const char *type; + const char *type = NULL; if (list_type >= OMP_LIST_REDUCTION_FIRST) { switch (list_type) @@ -1187,14 +1223,53 @@ show_omp_node (int level, gfc_code *c) case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break; case OMP_LIST_SHARED: type = "SHARED"; break; case OMP_LIST_COPYIN: type = "COPYIN"; break; + case OMP_LIST_UNIFORM: type = "UNIFORM"; break; + case OMP_LIST_ALIGNED: type = "ALIGNED"; break; + case OMP_LIST_LINEAR: type = "LINEAR"; break; + case OMP_LIST_DEPEND_IN: + fprintf (dumpfile, " DEPEND(IN:"); + break; + case OMP_LIST_DEPEND_OUT: + fprintf (dumpfile, " DEPEND(OUT:"); + break; default: gcc_unreachable (); } - fprintf (dumpfile, " %s(", type); + if (type) + fprintf (dumpfile, " %s(", type); } - show_namelist (omp_clauses->lists[list_type]); + show_omp_namelist (omp_clauses->lists[list_type]); fputc (')', dumpfile); } + if (omp_clauses->safelen_expr) + { + fputs (" SAFELEN(", dumpfile); + show_expr (omp_clauses->safelen_expr); + fputc (')', dumpfile); + } + if (omp_clauses->simdlen_expr) + { + fputs (" SIMDLEN(", dumpfile); + show_expr (omp_clauses->simdlen_expr); + fputc (')', dumpfile); + } + if (omp_clauses->inbranch) + fputs (" INBRANCH", dumpfile); + if (omp_clauses->notinbranch) + fputs (" NOTINBRANCH", dumpfile); + if (omp_clauses->proc_bind != OMP_PROC_BIND_UNKNOWN) + { + const char *type; + switch (omp_clauses->proc_bind) + { + case OMP_PROC_BIND_MASTER: type = "MASTER"; break; + case OMP_PROC_BIND_SPREAD: type = "SPREAD"; break; + case OMP_PROC_BIND_CLOSE: type = "CLOSE"; break; + default: + gcc_unreachable (); + } + fprintf (dumpfile, " PROC_BIND(%s)", type); + } } fputc ('\n', dumpfile); if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) @@ -1214,6 +1289,7 @@ show_omp_node (int level, gfc_code *c) show_code (level + 1, c->block->next); if (c->op == EXEC_OMP_ATOMIC) return; + fputc ('\n', dumpfile); code_indent (level, 0); fprintf (dumpfile, "!$OMP END %s", name); if (omp_clauses != NULL) @@ -1221,7 +1297,7 @@ show_omp_node (int level, gfc_code *c) if (omp_clauses->lists[OMP_LIST_COPYPRIVATE]) { fputs (" COPYPRIVATE(", dumpfile); - show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]); + show_omp_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]); fputc (')', dumpfile); } else if (omp_clauses->nowait) @@ -2195,19 +2271,25 @@ show_code_node (int level, gfc_code *c) break; case EXEC_OMP_ATOMIC: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: 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_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_WORKSHARE: diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 6c67e66108b..8bac7bf3516 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -2112,6 +2112,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: in_omp_workshare = false; @@ -2128,9 +2129,11 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, /* Fall through */ case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_END_SINGLE: + case EXEC_OMP_SIMD: case EXEC_OMP_TASK: /* Come to this label only from the @@ -2144,7 +2147,24 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->final_expr); WALK_SUBEXPR (co->ext.omp_clauses->num_threads); WALK_SUBEXPR (co->ext.omp_clauses->chunk_size); + WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr); + WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr); } + { + gfc_omp_namelist *n; + for (n = co->ext.omp_clauses->lists[OMP_LIST_ALIGNED]; + n; n = n->next) + WALK_SUBEXPR (n->expr); + for (n = co->ext.omp_clauses->lists[OMP_LIST_LINEAR]; + n; n = n->next) + WALK_SUBEXPR (n->expr); + for (n = co->ext.omp_clauses->lists[OMP_LIST_DEPEND_IN]; + n; n = n->next) + WALK_SUBEXPR (n->expr); + for (n = co->ext.omp_clauses->lists[OMP_LIST_DEPEND_OUT]; + n; n = n->next) + WALK_SUBEXPR (n->expr); + } break; default: break; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index d654d2ba97c..3e5cdbd7d49 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -211,8 +211,12 @@ typedef enum ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS, ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE, ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK, - ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, - ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE + ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_OMP_CANCEL, ST_OMP_CANCELLATION_POINT, + ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, ST_OMP_SIMD, ST_OMP_END_SIMD, + ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD, + ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_PROCEDURE, ST_GENERIC, + ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, + ST_UNLOCK, ST_NONE } gfc_statement; @@ -1033,6 +1037,19 @@ gfc_namelist; #define gfc_get_namelist() XCNEW (gfc_namelist) +/* For use in OpenMP clauses in case we need extra information + (aligned clause alignment, linear clause step, etc.). */ + +typedef struct gfc_omp_namelist +{ + struct gfc_symbol *sym; + struct gfc_expr *expr; + struct gfc_omp_namelist *next; +} +gfc_omp_namelist; + +#define gfc_get_omp_namelist() XCNEW (gfc_omp_namelist) + enum { OMP_LIST_PRIVATE, @@ -1041,6 +1058,11 @@ enum OMP_LIST_COPYPRIVATE, OMP_LIST_SHARED, OMP_LIST_COPYIN, + OMP_LIST_UNIFORM, + OMP_LIST_ALIGNED, + OMP_LIST_LINEAR, + OMP_LIST_DEPEND_IN, + OMP_LIST_DEPEND_OUT, OMP_LIST_PLUS, OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS, OMP_LIST_MULT, @@ -1080,23 +1102,60 @@ enum gfc_omp_default_sharing OMP_DEFAULT_FIRSTPRIVATE }; +enum gfc_omp_proc_bind_kind +{ + OMP_PROC_BIND_UNKNOWN, + OMP_PROC_BIND_MASTER, + OMP_PROC_BIND_SPREAD, + OMP_PROC_BIND_CLOSE +}; + +enum gfc_omp_cancel_kind +{ + OMP_CANCEL_UNKNOWN, + OMP_CANCEL_PARALLEL, + OMP_CANCEL_SECTIONS, + OMP_CANCEL_DO, + OMP_CANCEL_TASKGROUP +}; + typedef struct gfc_omp_clauses { struct gfc_expr *if_expr; struct gfc_expr *final_expr; struct gfc_expr *num_threads; - gfc_namelist *lists[OMP_LIST_NUM]; + gfc_omp_namelist *lists[OMP_LIST_NUM]; enum gfc_omp_sched_kind sched_kind; struct gfc_expr *chunk_size; enum gfc_omp_default_sharing default_sharing; int collapse; bool nowait, ordered, untied, mergeable; + bool inbranch, notinbranch; + enum gfc_omp_cancel_kind cancel; + enum gfc_omp_proc_bind_kind proc_bind; + struct gfc_expr *safelen_expr; + struct gfc_expr *simdlen_expr; } gfc_omp_clauses; #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses) +/* Node in the linked list used for storing !$omp declare simd constructs. */ + +typedef struct gfc_omp_declare_simd +{ + struct gfc_omp_declare_simd *next; + locus where; /* Where the !$omp declare simd construct occurred. */ + + gfc_symbol *proc_name; + + gfc_omp_clauses *clauses; +} +gfc_omp_declare_simd; +#define gfc_get_omp_declare_simd() XCNEW (gfc_omp_declare_simd) + + /* The gfc_st_label structure is a BBT attached to a namespace that records the usage of statement labels within that space. */ @@ -1469,6 +1528,9 @@ typedef struct gfc_namespace /* A list of USE statements in this namespace. */ gfc_use_list *use_stmts; + /* Linked list of !$omp declare simd constructs. */ + struct gfc_omp_declare_simd *omp_declare_simd; + /* Set to 1 if namespace is a BLOCK DATA program unit. */ unsigned is_block_data:1; @@ -2116,16 +2178,21 @@ typedef enum EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT, EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT, - EXEC_OMP_TASKYIELD + EXEC_OMP_TASKYIELD, EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD } gfc_exec_op; typedef enum { - GFC_OMP_ATOMIC_UPDATE, - GFC_OMP_ATOMIC_READ, - GFC_OMP_ATOMIC_WRITE, - GFC_OMP_ATOMIC_CAPTURE + GFC_OMP_ATOMIC_UPDATE = 0, + GFC_OMP_ATOMIC_READ = 1, + GFC_OMP_ATOMIC_WRITE = 2, + GFC_OMP_ATOMIC_CAPTURE = 3, + GFC_OMP_ATOMIC_MASK = 3, + GFC_OMP_ATOMIC_SEQ_CST = 4, + GFC_OMP_ATOMIC_SWAP = 8 } gfc_omp_atomic_op; @@ -2177,7 +2244,7 @@ typedef struct gfc_code gfc_entry_list *entry; gfc_omp_clauses *omp_clauses; const char *omp_name; - gfc_namelist *omp_namelist; + gfc_omp_namelist *omp_namelist; bool omp_bool; gfc_omp_atomic_op omp_atomic; } @@ -2733,6 +2800,7 @@ void gfc_free_iterator (gfc_iterator *, int); void gfc_free_forall_iterator (gfc_forall_iterator *); void gfc_free_alloc_list (gfc_alloc *); void gfc_free_namelist (gfc_namelist *); +void gfc_free_omp_namelist (gfc_omp_namelist *); void gfc_free_equiv (gfc_equiv *); void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *); void gfc_free_data (gfc_data *); @@ -2744,10 +2812,13 @@ gfc_expr *gfc_get_parentheses (gfc_expr *); /* openmp.c */ struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; }; void gfc_free_omp_clauses (gfc_omp_clauses *); +void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); +void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *); void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *); void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *); +void gfc_resolve_omp_declare_simd (gfc_namespace *); void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *); void gfc_omp_restore_state (struct gfc_omp_saved_state *); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 4c4609401a0..41915b4118e 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2595,7 +2595,10 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) && o != NULL && o->state == COMP_OMP_STRUCTURED_BLOCK && (o->head->op == EXEC_OMP_DO - || o->head->op == EXEC_OMP_PARALLEL_DO)) + || o->head->op == EXEC_OMP_PARALLEL_DO + || o->head->op == EXEC_OMP_SIMD + || o->head->op == EXEC_OMP_DO_SIMD + || o->head->op == EXEC_OMP_PARALLEL_DO_SIMD)) { int collapse = 1; gcc_assert (o->head->next != NULL @@ -4564,6 +4567,22 @@ gfc_free_namelist (gfc_namelist *name) } +/* Free an OpenMP namelist structure. */ + +void +gfc_free_omp_namelist (gfc_omp_namelist *name) +{ + gfc_omp_namelist *n; + + for (; name; name = n) + { + gfc_free_expr (name->expr); + n = name->next; + free (name); + } +} + + /* Match a NAMELIST statement. */ match diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 385e84020eb..51c6b728ab4 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -126,18 +126,25 @@ gfc_common_head *gfc_get_common (const char *, int); match gfc_match_omp_eos (void); match gfc_match_omp_atomic (void); match gfc_match_omp_barrier (void); +match gfc_match_omp_cancel (void); +match gfc_match_omp_cancellation_point (void); match gfc_match_omp_critical (void); +match gfc_match_omp_declare_simd (void); match gfc_match_omp_do (void); +match gfc_match_omp_do_simd (void); match gfc_match_omp_flush (void); match gfc_match_omp_master (void); match gfc_match_omp_ordered (void); match gfc_match_omp_parallel (void); match gfc_match_omp_parallel_do (void); +match gfc_match_omp_parallel_do_simd (void); match gfc_match_omp_parallel_sections (void); match gfc_match_omp_parallel_workshare (void); match gfc_match_omp_sections (void); +match gfc_match_omp_simd (void); match gfc_match_omp_single (void); match gfc_match_omp_task (void); +match gfc_match_omp_taskgroup (void); match gfc_match_omp_taskwait (void); match gfc_match_omp_taskyield (void); match gfc_match_omp_threadprivate (void); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 52fdebe340c..8b374a2e4b0 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3790,6 +3790,111 @@ mio_full_f2k_derived (gfc_symbol *sym) mio_rparen (); } +static const mstring omp_declare_simd_clauses[] = +{ + minit ("INBRANCH", 0), + minit ("NOTINBRANCH", 1), + minit ("SIMDLEN", 2), + minit ("UNIFORM", 3), + minit ("LINEAR", 4), + minit ("ALIGNED", 5), + minit (NULL, -1) +}; + +/* Handle !$omp declare simd. */ + +static void +mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp) +{ + if (iomode == IO_OUTPUT) + { + if (*odsp == NULL) + return; + } + else if (peek_atom () != ATOM_LPAREN) + return; + + gfc_omp_declare_simd *ods = *odsp; + + mio_lparen (); + if (iomode == IO_OUTPUT) + { + write_atom (ATOM_NAME, "OMP_DECLARE_SIMD"); + if (ods->clauses) + { + gfc_omp_namelist *n; + + if (ods->clauses->inbranch) + mio_name (0, omp_declare_simd_clauses); + if (ods->clauses->notinbranch) + mio_name (1, omp_declare_simd_clauses); + if (ods->clauses->simdlen_expr) + { + mio_name (2, omp_declare_simd_clauses); + mio_expr (&ods->clauses->simdlen_expr); + } + for (n = ods->clauses->lists[OMP_LIST_UNIFORM]; n; n = n->next) + { + mio_name (3, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + } + for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next) + { + mio_name (4, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + } + for (n = ods->clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + mio_name (5, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + } + } + } + else + { + gfc_omp_namelist **ptrs[3] = { NULL, NULL, NULL }; + + require_atom (ATOM_NAME); + *odsp = ods = gfc_get_omp_declare_simd (); + ods->where = gfc_current_locus; + ods->proc_name = ns->proc_name; + if (peek_atom () == ATOM_NAME) + { + ods->clauses = gfc_get_omp_clauses (); + ptrs[0] = &ods->clauses->lists[OMP_LIST_UNIFORM]; + ptrs[1] = &ods->clauses->lists[OMP_LIST_LINEAR]; + ptrs[2] = &ods->clauses->lists[OMP_LIST_ALIGNED]; + } + while (peek_atom () == ATOM_NAME) + { + gfc_omp_namelist *n; + int t = mio_name (0, omp_declare_simd_clauses); + + switch (t) + { + case 0: ods->clauses->inbranch = true; break; + case 1: ods->clauses->notinbranch = true; break; + case 2: mio_expr (&ods->clauses->simdlen_expr); break; + case 3: + case 4: + case 5: + *ptrs[t - 3] = n = gfc_get_omp_namelist (); + ptrs[t - 3] = &n->next; + mio_symbol_ref (&n->sym); + if (t != 3) + mio_expr (&n->expr); + break; + } + } + } + + mio_omp_declare_simd (ns, &ods->next); + + mio_rparen (); +} + /* Unlike most other routines, the address of the symbol node is already fixed on input and the name/module has already been filled in. @@ -3864,6 +3969,11 @@ mio_symbol (gfc_symbol *sym) if (sym->attr.flavor == FL_DERIVED) mio_integer (&(sym->hash_value)); + if (sym->formal_ns + && sym->formal_ns->proc_name == sym + && sym->formal_ns->entries == NULL) + mio_omp_declare_simd (sym->formal_ns, &sym->formal_ns->omp_declare_simd); + mio_rparen (); } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index dff3ab1ad91..16c777417bb 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -69,19 +69,47 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->final_expr); gfc_free_expr (c->num_threads); gfc_free_expr (c->chunk_size); + gfc_free_expr (c->safelen_expr); + gfc_free_expr (c->simdlen_expr); for (i = 0; i < OMP_LIST_NUM; i++) - gfc_free_namelist (c->lists[i]); + gfc_free_omp_namelist (c->lists[i]); free (c); } +/* Free an !$omp declare simd construct list. */ + +void +gfc_free_omp_declare_simd (gfc_omp_declare_simd *ods) +{ + if (ods) + { + gfc_free_omp_clauses (ods->clauses); + free (ods); + } +} + +void +gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *list) +{ + while (list) + { + gfc_omp_declare_simd *current = list; + list = list->next; + gfc_free_omp_declare_simd (current); + } +} + + /* Match a variable/common block list and construct a namelist from it. */ static match -gfc_match_omp_variable_list (const char *str, gfc_namelist **list, - bool allow_common) +gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, + bool allow_common, bool *end_colon = NULL, + gfc_omp_namelist ***headp = NULL, + bool allow_sections = false) { - gfc_namelist *head, *tail, *p; - locus old_loc; + gfc_omp_namelist *head, *tail, *p; + locus old_loc, cur_loc; char n[GFC_MAX_SYMBOL_LEN+1]; gfc_symbol *sym; match m; @@ -97,12 +125,29 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, for (;;) { + cur_loc = gfc_current_locus; m = gfc_match_symbol (&sym, 1); switch (m) { case MATCH_YES: + gfc_expr *expr; + expr = NULL; + if (allow_sections && gfc_peek_ascii_char () == '(') + { + gfc_current_locus = cur_loc; + m = gfc_match_variable (&expr, 0); + switch (m) + { + case MATCH_ERROR: + goto cleanup; + case MATCH_NO: + goto syntax; + default: + break; + } + } gfc_set_sym_referenced (sym); - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); if (head == NULL) head = tail = p; else @@ -111,6 +156,7 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, tail = tail->next; } tail->sym = sym; + tail->expr = expr; goto next_item; case MATCH_NO: break; @@ -136,7 +182,7 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, for (sym = st->n.common->head; sym; sym = sym->common_next) { gfc_set_sym_referenced (sym); - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); if (head == NULL) head = tail = p; else @@ -148,6 +194,11 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, } next_item: + if (end_colon && gfc_match_char (':') == MATCH_YES) + { + *end_colon = true; + break; + } if (gfc_match_char (')') == MATCH_YES) break; if (gfc_match_char (',') != MATCH_YES) @@ -158,13 +209,15 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, list = &(*list)->next; *list = head; + if (headp) + *headp = list; return MATCH_YES; syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_namelist (head); + gfc_free_omp_namelist (head); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -185,16 +238,25 @@ cleanup: #define OMP_CLAUSE_UNTIED (1 << 13) #define OMP_CLAUSE_FINAL (1 << 14) #define OMP_CLAUSE_MERGEABLE (1 << 15) +#define OMP_CLAUSE_ALIGNED (1 << 16) +#define OMP_CLAUSE_DEPEND (1 << 17) +#define OMP_CLAUSE_INBRANCH (1 << 18) +#define OMP_CLAUSE_LINEAR (1 << 19) +#define OMP_CLAUSE_NOTINBRANCH (1 << 20) +#define OMP_CLAUSE_PROC_BIND (1 << 21) +#define OMP_CLAUSE_SAFELEN (1 << 22) +#define OMP_CLAUSE_SIMDLEN (1 << 23) +#define OMP_CLAUSE_UNIFORM (1 << 24) /* Match OpenMP directive clauses. MASK is a bitmask of clauses that are allowed for a particular directive. */ static match -gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) +gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask, bool first = true, + bool needs_space = true) { gfc_omp_clauses *c = gfc_get_omp_clauses (); locus old_loc; - bool needs_space = true, first = true; *cp = NULL; while (1) @@ -419,6 +481,115 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) continue; } } + if ((mask & OMP_CLAUSE_INBRANCH) && !c->inbranch + && gfc_match ("inbranch") == MATCH_YES) + { + c->inbranch = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_NOTINBRANCH) && !c->notinbranch + && gfc_match ("notinbranch") == MATCH_YES) + { + c->notinbranch = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_PROC_BIND) + && c->proc_bind == OMP_PROC_BIND_UNKNOWN) + { + if (gfc_match ("proc_bind ( master )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_MASTER; + else if (gfc_match ("proc_bind ( spread )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_SPREAD; + else if (gfc_match ("proc_bind ( close )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_CLOSE; + if (c->proc_bind != OMP_PROC_BIND_UNKNOWN) + continue; + } + if ((mask & OMP_CLAUSE_SAFELEN) && c->safelen_expr == NULL + && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_SIMDLEN) && c->simdlen_expr == NULL + && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_UNIFORM) + && gfc_match_omp_variable_list ("uniform (", + &c->lists[OMP_LIST_UNIFORM], false) + == MATCH_YES) + continue; + bool end_colon = false; + gfc_omp_namelist **head = NULL; + old_loc = gfc_current_locus; + if ((mask & OMP_CLAUSE_ALIGNED) + && gfc_match_omp_variable_list ("aligned (", + &c->lists[OMP_LIST_ALIGNED], false, + &end_colon, &head) + == MATCH_YES) + { + gfc_expr *alignment = NULL; + gfc_omp_namelist *n; + + if (end_colon + && gfc_match (" %e )", &alignment) != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + for (n = *head; n; n = n->next) + if (n->next && alignment) + n->expr = gfc_copy_expr (alignment); + else + n->expr = alignment; + continue; + } + end_colon = false; + head = NULL; + old_loc = gfc_current_locus; + if ((mask & OMP_CLAUSE_LINEAR) + && gfc_match_omp_variable_list ("linear (", + &c->lists[OMP_LIST_LINEAR], false, + &end_colon, &head) + == MATCH_YES) + { + gfc_expr *step = NULL; + + if (end_colon + && gfc_match (" %e )", &step) != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + else if (!end_colon) + { + step = gfc_get_constant_expr (BT_INTEGER, + gfc_default_integer_kind, + &old_loc); + mpz_set_si (step->value.integer, 1); + } + (*head)->expr = step; + continue; + } + if ((mask & OMP_CLAUSE_DEPEND) + && gfc_match_omp_variable_list ("depend ( in : ", + &c->lists[OMP_LIST_DEPEND_IN], false, + NULL, NULL, true) + == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_DEPEND) + && gfc_match_omp_variable_list ("depend ( out : ", + &c->lists[OMP_LIST_DEPEND_OUT], false, + NULL, NULL, true) + == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_DEPEND) + && gfc_match_omp_variable_list ("depend ( inout : ", + &c->lists[OMP_LIST_DEPEND_OUT], false, + NULL, NULL, true) + == MATCH_YES) + continue; break; } @@ -436,7 +607,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) #define OMP_PARALLEL_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \ - | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT) + | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PROC_BIND) +#define OMP_DECLARE_SIMD_CLAUSES \ + (OMP_CLAUSE_SIMDLEN | OMP_CLAUSE_LINEAR | OMP_CLAUSE_UNIFORM \ + | OMP_CLAUSE_ALIGNED) #define OMP_DO_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ @@ -444,10 +618,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) #define OMP_SECTIONS_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) +#define OMP_SIMD_CLAUSES \ + (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ + | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN | OMP_CLAUSE_LINEAR \ + | OMP_CLAUSE_ALIGNED) #define OMP_TASK_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \ - | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE) + | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_DEPEND) match gfc_match_omp_parallel (void) @@ -532,14 +710,28 @@ gfc_match_omp_do (void) match +gfc_match_omp_do_simd (void) +{ + gfc_omp_clauses *c; + if (gfc_match_omp_clauses (&c, ((OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED)) + != MATCH_YES) + return MATCH_ERROR; + new_st.op = EXEC_OMP_DO_SIMD; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match gfc_match_omp_flush (void) { - gfc_namelist *list = NULL; + gfc_omp_namelist *list = NULL; gfc_match_omp_variable_list (" (", &list, true); if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); - gfc_free_namelist (list); + gfc_free_omp_namelist (list); return MATCH_ERROR; } new_st.op = EXEC_OMP_FLUSH; @@ -549,6 +741,43 @@ gfc_match_omp_flush (void) match +gfc_match_omp_simd (void) +{ + gfc_omp_clauses *c; + if (gfc_match_omp_clauses (&c, OMP_SIMD_CLAUSES) != MATCH_YES) + return MATCH_ERROR; + new_st.op = EXEC_OMP_SIMD; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match +gfc_match_omp_declare_simd (void) +{ + locus where = gfc_current_locus; + gfc_symbol *proc_name; + gfc_omp_clauses *c; + gfc_omp_declare_simd *ods; + + if (gfc_match (" ( %s ) ", &proc_name) != MATCH_YES) + return MATCH_ERROR; + + if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true, + false) != MATCH_YES) + return MATCH_ERROR; + + ods = gfc_get_omp_declare_simd (); + ods->where = where; + ods->proc_name = proc_name; + ods->clauses = c; + ods->next = gfc_current_ns->omp_declare_simd; + gfc_current_ns->omp_declare_simd = ods; + return MATCH_YES; +} + + +match gfc_match_omp_threadprivate (void) { locus old_loc; @@ -630,6 +859,20 @@ gfc_match_omp_parallel_do (void) match +gfc_match_omp_parallel_do_simd (void) +{ + gfc_omp_clauses *c; + if (gfc_match_omp_clauses (&c, (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES + | OMP_SIMD_CLAUSES) & ~OMP_CLAUSE_ORDERED) + != MATCH_YES) + return MATCH_ERROR; + new_st.op = EXEC_OMP_PARALLEL_DO_SIMD; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match gfc_match_omp_parallel_sections (void) { gfc_omp_clauses *c; @@ -725,20 +968,44 @@ match gfc_match_omp_atomic (void) { gfc_omp_atomic_op op = GFC_OMP_ATOMIC_UPDATE; - if (gfc_match ("% update") == MATCH_YES) - op = GFC_OMP_ATOMIC_UPDATE; - else if (gfc_match ("% read") == MATCH_YES) - op = GFC_OMP_ATOMIC_READ; - else if (gfc_match ("% write") == MATCH_YES) - op = GFC_OMP_ATOMIC_WRITE; - else if (gfc_match ("% capture") == MATCH_YES) - op = GFC_OMP_ATOMIC_CAPTURE; + int seq_cst = 0; + if (gfc_match ("% seq_cst") == MATCH_YES) + seq_cst = 1; + locus old_loc = gfc_current_locus; + if (seq_cst && gfc_match_char (',') == MATCH_YES) + seq_cst = 2; + if (seq_cst == 2 + || gfc_match_space () == MATCH_YES) + { + gfc_gobble_whitespace (); + if (gfc_match ("update") == MATCH_YES) + op = GFC_OMP_ATOMIC_UPDATE; + else if (gfc_match ("read") == MATCH_YES) + op = GFC_OMP_ATOMIC_READ; + else if (gfc_match ("write") == MATCH_YES) + op = GFC_OMP_ATOMIC_WRITE; + else if (gfc_match ("capture") == MATCH_YES) + op = GFC_OMP_ATOMIC_CAPTURE; + else + { + if (seq_cst == 2) + gfc_current_locus = old_loc; + goto finish; + } + if (!seq_cst + && (gfc_match (", seq_cst") == MATCH_YES + || gfc_match ("% seq_cst") == MATCH_YES)) + seq_cst = 1; + } + finish: if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C"); return MATCH_ERROR; } new_st.op = EXEC_OMP_ATOMIC; + if (seq_cst) + op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST); new_st.ext.omp_atomic = op; return MATCH_YES; } @@ -759,6 +1026,73 @@ gfc_match_omp_barrier (void) match +gfc_match_omp_taskgroup (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP TASKGROUP statement at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKGROUP; + return MATCH_YES; +} + + +static enum gfc_omp_cancel_kind +gfc_match_omp_cancel_kind (void) +{ + if (gfc_match_space () != MATCH_YES) + return OMP_CANCEL_UNKNOWN; + if (gfc_match ("parallel") == MATCH_YES) + return OMP_CANCEL_PARALLEL; + if (gfc_match ("sections") == MATCH_YES) + return OMP_CANCEL_SECTIONS; + if (gfc_match ("do") == MATCH_YES) + return OMP_CANCEL_DO; + if (gfc_match ("taskgroup") == MATCH_YES) + return OMP_CANCEL_TASKGROUP; + return OMP_CANCEL_UNKNOWN; +} + + +match +gfc_match_omp_cancel (void) +{ + gfc_omp_clauses *c; + enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); + if (kind == OMP_CANCEL_UNKNOWN) + return MATCH_ERROR; + if (gfc_match_omp_clauses (&c, OMP_CLAUSE_IF, false) != MATCH_YES) + return MATCH_ERROR; + c->cancel = kind; + new_st.op = EXEC_OMP_CANCEL; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match +gfc_match_omp_cancellation_point (void) +{ + gfc_omp_clauses *c; + enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); + if (kind == OMP_CANCEL_UNKNOWN) + return MATCH_ERROR; + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement " + "at %C"); + return MATCH_ERROR; + } + c = gfc_get_omp_clauses (); + c->cancel = kind; + new_st.op = EXEC_OMP_CANCELLATION_POINT; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match gfc_match_omp_end_nowait (void) { bool nowait = false; @@ -796,14 +1130,15 @@ gfc_match_omp_end_single (void) /* OpenMP directive resolving routines. */ static void -resolve_omp_clauses (gfc_code *code) +resolve_omp_clauses (gfc_code *code, locus *where, + gfc_omp_clauses *omp_clauses, gfc_namespace *ns) { - gfc_omp_clauses *omp_clauses = code->ext.omp_clauses; - gfc_namelist *n; + gfc_omp_namelist *n; int list; static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", - "COPYIN", "REDUCTION" }; + "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "DEPEND", + "REDUCTION" }; if (omp_clauses == NULL) return; @@ -847,8 +1182,15 @@ resolve_omp_clauses (gfc_code *code) for (n = omp_clauses->lists[list]; n; n = n->next) { n->sym->mark = 0; - if (n->sym->attr.flavor == FL_VARIABLE || n->sym->attr.proc_pointer) - continue; + if (n->sym->attr.flavor == FL_VARIABLE + || n->sym->attr.proc_pointer + || (!code && (!n->sym->attr.dummy || n->sym->ns != ns))) + { + if (!code && (!n->sym->attr.dummy || n->sym->ns != ns)) + gfc_error ("Variable '%s' is not a dummy argument at %L", + n->sym->name, where); + continue; + } if (n->sym->attr.flavor == FL_PROCEDURE && n->sym->result == n->sym && n->sym->attr.function) @@ -878,16 +1220,20 @@ resolve_omp_clauses (gfc_code *code) } } gfc_error ("Object '%s' is not a variable at %L", n->sym->name, - &code->loc); + where); } for (list = 0; list < OMP_LIST_NUM; list++) - if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE) + if (list != OMP_LIST_FIRSTPRIVATE + && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALIGNED + && list != OMP_LIST_DEPEND_IN + && list != OMP_LIST_DEPEND_OUT) for (n = omp_clauses->lists[list]; n; n = n->next) { if (n->sym->mark) gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); else n->sym->mark = 1; } @@ -898,7 +1244,7 @@ resolve_omp_clauses (gfc_code *code) if (n->sym->mark) { gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); n->sym->mark = 0; } @@ -906,7 +1252,7 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->mark) gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); else n->sym->mark = 1; } @@ -917,10 +1263,23 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->mark) gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); else n->sym->mark = 1; } + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + n->sym->mark = 0; + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol '%s' present on multiple clauses at %L", + n->sym->name, where); + else + n->sym->mark = 1; + } + for (list = 0; list < OMP_LIST_NUM; list++) if ((n = omp_clauses->lists[list]) != NULL) { @@ -940,10 +1299,10 @@ resolve_omp_clauses (gfc_code *code) { if (!n->sym->attr.threadprivate) gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause" - " at %L", n->sym->name, &code->loc); + " at %L", n->sym->name, where); if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp) gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components", - n->sym->name, &code->loc); + n->sym->name, where); } break; case OMP_LIST_COPYPRIVATE: @@ -951,10 +1310,10 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array '%s' in COPYPRIVATE clause " - "at %L", n->sym->name, &code->loc); + "at %L", n->sym->name, where); if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp) gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components", - n->sym->name, &code->loc); + n->sym->name, where); } break; case OMP_LIST_SHARED: @@ -962,49 +1321,128 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object '%s' in SHARED clause at " - "%L", n->sym->name, &code->loc); + "%L", n->sym->name, where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee '%s' in SHARED clause at %L", - n->sym->name, &code->loc); + n->sym->name, where); + } + break; + case OMP_LIST_ALIGNED: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.pointer + && !n->sym->attr.allocatable + && !n->sym->attr.cray_pointer + && (n->sym->ts.type != BT_DERIVED + || (n->sym->ts.u.derived->from_intmod + != INTMOD_ISO_C_BINDING) + || (n->sym->ts.u.derived->intmod_sym_id + != ISOCBINDING_PTR))) + gfc_error ("'%s' in ALIGNED clause must be POINTER, " + "ALLOCATABLE, Cray pointer or C_PTR at %L", + n->sym->name, where); + else if (n->expr) + { + gfc_expr *expr = n->expr; + int alignment = 0; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER + || expr->rank != 0 + || gfc_extract_int (expr, &alignment) + || alignment <= 0) + gfc_error ("'%s' in ALIGNED clause at %L requires a scalar " + "positive constant integer alignment " + "expression", n->sym->name, where); + } } break; + case OMP_LIST_DEPEND_IN: + case OMP_LIST_DEPEND_OUT: + for (; n != NULL; n = n->next) + if (n->expr) + { + if (!gfc_resolve_expr (n->expr) + || n->expr->expr_type != EXPR_VARIABLE + || n->expr->ref == NULL + || n->expr->ref->next + || n->expr->ref->type != REF_ARRAY) + gfc_error ("'%s' in DEPEND clause at %L is not a proper " + "array section", n->sym->name, where); + else if (n->expr->ref->u.ar.codimen) + gfc_error ("Coarrays not supported in DEPEND clause at %L", + where); + else + { + int i; + gfc_array_ref *ar = &n->expr->ref->u.ar; + for (i = 0; i < ar->dimen; i++) + if (ar->stride[i]) + { + gfc_error ("Stride should not be specified for " + "array section in DEPEND clause at %L", + where); + break; + } + else if (ar->dimen_type[i] != DIMEN_ELEMENT + && ar->dimen_type[i] != DIMEN_RANGE) + { + gfc_error ("'%s' in DEPEND clause at %L is not a " + "proper array section", + n->sym->name, where); + break; + } + else if (ar->start[i] + && ar->start[i]->expr_type == EXPR_CONSTANT + && ar->end[i] + && ar->end[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (ar->start[i]->value.integer, + ar->end[i]->value.integer) > 0) + { + gfc_error ("'%s' in DEPEND clause at %L is a zero " + "size array section", n->sym->name, + where); + break; + } + } + } + break; default: for (; n != NULL; n = n->next) { if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); if (list != OMP_LIST_PRIVATE) { if (n->sym->attr.pointer && list >= OMP_LIST_REDUCTION_FIRST && list <= OMP_LIST_REDUCTION_LAST) gfc_error ("POINTER object '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below). */ if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) && n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp) gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L", - name, n->sym->name, &code->loc); + name, n->sym->name, where); if (n->sym->attr.cray_pointer && list >= OMP_LIST_REDUCTION_FIRST && list <= OMP_LIST_REDUCTION_LAST) gfc_error ("Cray pointer '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); } if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); if (n->sym->attr.in_namelist && (list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST)) gfc_error ("Variable '%s' in %s clause is used in " "NAMELIST statement at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); switch (list) { case OMP_LIST_PLUS: @@ -1014,7 +1452,7 @@ resolve_omp_clauses (gfc_code *code) gfc_error ("%c REDUCTION variable '%s' at %L must be of numeric type, got %s", list == OMP_LIST_PLUS ? '+' : list == OMP_LIST_MULT ? '*' : '-', - n->sym->name, &code->loc, + n->sym->name, where, gfc_typename (&n->sym->ts)); break; case OMP_LIST_AND: @@ -1027,7 +1465,7 @@ resolve_omp_clauses (gfc_code *code) list == OMP_LIST_AND ? ".AND." : list == OMP_LIST_OR ? ".OR." : list == OMP_LIST_EQV ? ".EQV." : ".NEQV.", - n->sym->name, &code->loc); + n->sym->name, where); break; case OMP_LIST_MAX: case OMP_LIST_MIN: @@ -1036,7 +1474,7 @@ resolve_omp_clauses (gfc_code *code) gfc_error ("%s REDUCTION variable '%s' must be " "INTEGER or REAL at %L", list == OMP_LIST_MAX ? "MAX" : "MIN", - n->sym->name, &code->loc); + n->sym->name, where); break; case OMP_LIST_IAND: case OMP_LIST_IOR: @@ -1046,12 +1484,34 @@ resolve_omp_clauses (gfc_code *code) "at %L", list == OMP_LIST_IAND ? "IAND" : list == OMP_LIST_MULT ? "IOR" : "IEOR", - n->sym->name, &code->loc); + n->sym->name, where); + break; + case OMP_LIST_LINEAR: + if (n->sym->ts.type != BT_INTEGER) + gfc_error ("LINEAR variable '%s' must be INTEGER " + "at %L", n->sym->name, where); + else if (!code && !n->sym->attr.value) + gfc_error ("LINEAR dummy argument '%s' must have VALUE " + "attribute at %L", n->sym->name, where); + else if (n->expr) + { + gfc_expr *expr = n->expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER + || expr->rank != 0) + gfc_error ("'%s' in LINEAR clause at %L requires " + "a scalar integer linear-step expression", + n->sym->name, where); + else if (!code && expr->expr_type != EXPR_CONSTANT) + gfc_error ("'%s' in LINEAR clause at %L requires " + "a constant integer linear-step expression", + n->sym->name, where); + } break; /* Workaround for PR middle-end/26316, nothing really needs to be done here for OMP_LIST_PRIVATE. */ case OMP_LIST_PRIVATE: - gcc_assert (code->op != EXEC_NOP); + gcc_assert (code && code->op != EXEC_NOP); default: break; } @@ -1059,6 +1519,22 @@ resolve_omp_clauses (gfc_code *code) break; } } + if (omp_clauses->safelen_expr) + { + gfc_expr *expr = omp_clauses->safelen_expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("SAFELEN clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->simdlen_expr) + { + gfc_expr *expr = omp_clauses->simdlen_expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("SIMDLEN clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } } @@ -1142,12 +1618,13 @@ resolve_omp_atomic (gfc_code *code) gfc_code *atomic_code = code; gfc_symbol *var; gfc_expr *expr2, *expr2_tmp; + gfc_omp_atomic_op aop + = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); - gcc_assert ((atomic_code->ext.omp_atomic != GFC_OMP_ATOMIC_CAPTURE - && code->next == NULL) - || (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE + gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) && code->next == NULL) + || ((aop == GFC_OMP_ATOMIC_CAPTURE) && code->next != NULL && code->next->op == EXEC_ASSIGN && code->next->next == NULL)); @@ -1169,14 +1646,13 @@ resolve_omp_atomic (gfc_code *code) expr2 = is_conversion (code->expr2, false); if (expr2 == NULL) { - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_READ - || atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (aop == GFC_OMP_ATOMIC_READ || aop == GFC_OMP_ATOMIC_WRITE) expr2 = is_conversion (code->expr2, true); if (expr2 == NULL) expr2 = code->expr2; } - switch (atomic_code->ext.omp_atomic) + switch (aop) { case GFC_OMP_ATOMIC_READ: if (expr2->expr_type != EXPR_VARIABLE @@ -1249,7 +1725,21 @@ resolve_omp_atomic (gfc_code *code) break; } - if (expr2->expr_type == EXPR_OP) + if (var->attr.allocatable) + { + gfc_error ("!$OMP ATOMIC with ALLOCATABLE variable at %L", + &code->loc); + return; + } + + if (aop == GFC_OMP_ATOMIC_CAPTURE + && code->next == NULL + && code->expr2->rank == 0 + && !expr_references_sym (code->expr2, var, NULL)) + atomic_code->ext.omp_atomic + = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic + | GFC_OMP_ATOMIC_SWAP); + else if (expr2->expr_type == EXPR_OP) { gfc_expr *v = NULL, *e, *c; gfc_intrinsic_op op = expr2->value.op.op; @@ -1420,11 +1910,18 @@ resolve_omp_atomic (gfc_code *code) && arg->expr->symtree->n.sym == var) var_arg = arg; else if (expr_references_sym (arg->expr, var, NULL)) - gfc_error ("!$OMP ATOMIC intrinsic arguments except one must not " - "reference '%s' at %L", var->name, &arg->expr->where); + { + gfc_error ("!$OMP ATOMIC intrinsic arguments except one must " + "not reference '%s' at %L", + var->name, &arg->expr->where); + return; + } if (arg->expr->rank != 0) - gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar " - "at %L", &arg->expr->where); + { + gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar " + "at %L", &arg->expr->where); + return; + } } if (var_arg == NULL) @@ -1447,10 +1944,10 @@ resolve_omp_atomic (gfc_code *code) } } else - gfc_error ("!$OMP ATOMIC assignment must have an operator or intrinsic " - "on right hand side at %L", &expr2->where); + gfc_error ("!$OMP ATOMIC assignment must have an operator or " + "intrinsic on right hand side at %L", &expr2->where); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE && code->next) + if (aop == GFC_OMP_ATOMIC_CAPTURE && code->next) { code = code->next; if (code->expr1->expr_type != EXPR_VARIABLE @@ -1542,7 +2039,7 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) { struct omp_context ctx; gfc_omp_clauses *omp_clauses = code->ext.omp_clauses; - gfc_namelist *n; + gfc_omp_namelist *n; int list; ctx.code = code; @@ -1555,7 +2052,8 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) for (n = omp_clauses->lists[list]; n; n = n->next) pointer_set_insert (ctx.sharing_clauses, n->sym); - if (code->op == EXEC_OMP_PARALLEL_DO) + if (code->op == EXEC_OMP_PARALLEL_DO + || code->op == EXEC_OMP_PARALLEL_DO_SIMD) gfc_resolve_omp_do_blocks (code, ns); else gfc_resolve_blocks (code->block, ns); @@ -1624,9 +2122,9 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) if (! pointer_set_insert (omp_current_ctx->private_iterators, sym)) { gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses; - gfc_namelist *p; + gfc_omp_namelist *p; - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); p->sym = sym; p->next = omp_clauses->lists[OMP_LIST_PRIVATE]; omp_clauses->lists[OMP_LIST_PRIVATE] = p; @@ -1639,11 +2137,25 @@ resolve_omp_do (gfc_code *code) { gfc_code *do_code, *c; int list, i, collapse; - gfc_namelist *n; + gfc_omp_namelist *n; gfc_symbol *dovar; + const char *name; + bool is_simd = false; + + switch (code->op) + { + case EXEC_OMP_DO: name = "!$OMP DO"; break; + case EXEC_OMP_DO_SIMD: name = "!$OMP DO SIMD"; is_simd = true; break; + case EXEC_OMP_PARALLEL_DO: name = "!$OMP PARALLEL DO"; break; + case EXEC_OMP_PARALLEL_DO_SIMD: + name = "!$OMP PARALLEL DO SIMD"; + is_simd = true; break; + case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break; + default: gcc_unreachable (); + } if (code->ext.omp_clauses) - resolve_omp_clauses (code); + resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); do_code = code->block->next; collapse = code->ext.omp_clauses->collapse; @@ -1653,27 +2165,40 @@ resolve_omp_do (gfc_code *code) { if (do_code->op == EXEC_DO_WHILE) { - gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control " - "at %L", &do_code->loc); + gfc_error ("%s cannot be a DO WHILE or DO without loop control " + "at %L", name, &do_code->loc); break; } gcc_assert (do_code->op == EXEC_DO); if (do_code->ext.iterator->var->ts.type != BT_INTEGER) - gfc_error ("!$OMP DO iteration variable must be of type integer at %L", - &do_code->loc); + gfc_error ("%s iteration variable must be of type integer at %L", + name, &do_code->loc); dovar = do_code->ext.iterator->var->symtree->n.sym; if (dovar->attr.threadprivate) - gfc_error ("!$OMP DO iteration variable must not be THREADPRIVATE " - "at %L", &do_code->loc); + gfc_error ("%s iteration variable must not be THREADPRIVATE " + "at %L", name, &do_code->loc); if (code->ext.omp_clauses) for (list = 0; list < OMP_LIST_NUM; list++) - if (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + if (!is_simd + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + : code->ext.omp_clauses->collapse > 1 + ? (list != OMP_LIST_LASTPRIVATE) + : (list != OMP_LIST_LINEAR)) for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) if (dovar == n->sym) { - gfc_error ("!$OMP DO iteration variable present on clause " - "other than PRIVATE or LASTPRIVATE at %L", - &do_code->loc); + if (!is_simd) + gfc_error ("%s iteration variable present on clause " + "other than PRIVATE or LASTPRIVATE at %L", + name, &do_code->loc); + else if (code->ext.omp_clauses->collapse > 1) + gfc_error ("%s iteration variable present on clause " + "other than LASTPRIVATE at %L", + name, &do_code->loc); + else + gfc_error ("%s iteration variable present on clause " + "other than LINEAR at %L", + name, &do_code->loc); break; } if (i > 1) @@ -1689,8 +2214,8 @@ resolve_omp_do (gfc_code *code) || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end) || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step)) { - gfc_error ("!$OMP DO collapsed loops don't form rectangular iteration space at %L", - &do_code->loc); + gfc_error ("%s collapsed loops don't form rectangular " + "iteration space at %L", name, &do_code->loc); break; } if (j < i) @@ -1703,8 +2228,8 @@ resolve_omp_do (gfc_code *code) for (c = do_code->next; c; c = c->next) if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE) { - gfc_error ("collapsed !$OMP DO loops not perfectly nested at %L", - &c->loc); + gfc_error ("collapsed %s loops not perfectly nested at %L", + name, &c->loc); break; } if (c) @@ -1712,16 +2237,16 @@ resolve_omp_do (gfc_code *code) do_code = do_code->block; if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE) { - gfc_error ("not enough DO loops for collapsed !$OMP DO at %L", - &code->loc); + gfc_error ("not enough DO loops for collapsed %s at %L", + name, &code->loc); break; } do_code = do_code->next; if (do_code == NULL || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)) { - gfc_error ("not enough DO loops for collapsed !$OMP DO at %L", - &code->loc); + gfc_error ("not enough DO loops for collapsed %s at %L", + name, &code->loc); break; } } @@ -1740,18 +2265,22 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) switch (code->op) { case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_SIMD: resolve_omp_do (code); break; - case EXEC_OMP_WORKSHARE: + case EXEC_OMP_CANCEL: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_TASK: + case EXEC_OMP_WORKSHARE: if (code->ext.omp_clauses) - resolve_omp_clauses (code); + resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); break; case EXEC_OMP_ATOMIC: resolve_omp_atomic (code); @@ -1760,3 +2289,20 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) break; } } + +/* Resolve !$omp declare simd constructs in NS. */ + +void +gfc_resolve_omp_declare_simd (gfc_namespace *ns) +{ + gfc_omp_declare_simd *ods; + + for (ods = ns->omp_declare_simd; ods; ods = ods->next) + { + if (ods->proc_name != ns->proc_name) + gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure" + "'%s' at %L", ns->proc_name->name, &ods->where); + if (ods->clauses) + resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns); + } +} diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 77667150176..9735714ea9e 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -569,17 +569,27 @@ decode_omp_directive (void) match ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER); break; case 'c': + match ("cancellation% point", gfc_match_omp_cancellation_point, + ST_OMP_CANCELLATION_POINT); + match ("cancel", gfc_match_omp_cancel, ST_OMP_CANCEL); match ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL); break; case 'd': + match ("declare simd", gfc_match_omp_declare_simd, + ST_OMP_DECLARE_SIMD); + match ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD); match ("do", gfc_match_omp_do, ST_OMP_DO); break; case 'e': match ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC); match ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL); + match ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD); match ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); + match ("end simd", gfc_match_omp_eos, ST_OMP_END_SIMD); match ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER); match ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED); + match ("end parallel do simd", gfc_match_omp_eos, + ST_OMP_END_PARALLEL_DO_SIMD); match ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO); match ("end parallel sections", gfc_match_omp_eos, ST_OMP_END_PARALLEL_SECTIONS); @@ -588,6 +598,7 @@ decode_omp_directive (void) match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL); match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); + match ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP); match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); match ("end workshare", gfc_match_omp_end_nowait, ST_OMP_END_WORKSHARE); @@ -602,6 +613,8 @@ decode_omp_directive (void) match ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); break; case 'p': + match ("parallel do simd", gfc_match_omp_parallel_do_simd, + ST_OMP_PARALLEL_DO_SIMD); match ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO); match ("parallel sections", gfc_match_omp_parallel_sections, ST_OMP_PARALLEL_SECTIONS); @@ -612,12 +625,14 @@ decode_omp_directive (void) case 's': match ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); match ("section", gfc_match_omp_eos, ST_OMP_SECTION); + match ("simd", gfc_match_omp_simd, ST_OMP_SIMD); match ("single", gfc_match_omp_single, ST_OMP_SINGLE); break; case 't': - match ("task", gfc_match_omp_task, ST_OMP_TASK); + match ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP); match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT); match ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD); + match ("task", gfc_match_omp_task, ST_OMP_TASK); match ("threadprivate", gfc_match_omp_threadprivate, ST_OMP_THREADPRIVATE); break; @@ -1013,6 +1028,7 @@ next_statement (void) case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \ + case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ case ST_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \ case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK @@ -1026,14 +1042,15 @@ next_statement (void) case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ - case ST_OMP_TASK: case ST_CRITICAL + case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \ + case ST_OMP_DO_SIMD: case ST_OMP_PARALLEL_DO_SIMD: case ST_CRITICAL /* Declaration statements */ #define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \ case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \ case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \ - case ST_PROCEDURE + case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD /* Block end statements. Errors associated with interchanging these are detected in gfc_match_end(). */ @@ -1524,12 +1541,24 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_BARRIER: p = "!$OMP BARRIER"; break; + case ST_OMP_CANCEL: + p = "!$OMP CANCEL"; + break; + case ST_OMP_CANCELLATION_POINT: + p = "!$OMP CANCELLATION POINT"; + break; case ST_OMP_CRITICAL: p = "!$OMP CRITICAL"; break; + case ST_OMP_DECLARE_SIMD: + p = "!$OMP DECLARE SIMD"; + break; case ST_OMP_DO: p = "!$OMP DO"; break; + case ST_OMP_DO_SIMD: + p = "!$OMP DO SIMD"; + break; case ST_OMP_END_ATOMIC: p = "!$OMP END ATOMIC"; break; @@ -1539,6 +1568,12 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_DO: p = "!$OMP END DO"; break; + case ST_OMP_END_DO_SIMD: + p = "!$OMP END DO SIMD"; + break; + case ST_OMP_END_SIMD: + p = "!$OMP END SIMD"; + break; case ST_OMP_END_MASTER: p = "!$OMP END MASTER"; break; @@ -1551,6 +1586,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_PARALLEL_DO: p = "!$OMP END PARALLEL DO"; break; + case ST_OMP_END_PARALLEL_DO_SIMD: + p = "!$OMP END PARALLEL DO SIMD"; + break; case ST_OMP_END_PARALLEL_SECTIONS: p = "!$OMP END PARALLEL SECTIONS"; break; @@ -1566,6 +1604,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TASK: p = "!$OMP END TASK"; break; + case ST_OMP_END_TASKGROUP: + p = "!$OMP END TASKGROUP"; + break; case ST_OMP_END_WORKSHARE: p = "!$OMP END WORKSHARE"; break; @@ -1584,6 +1625,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_PARALLEL_DO: p = "!$OMP PARALLEL DO"; break; + case ST_OMP_PARALLEL_DO_SIMD: + p = "!$OMP PARALLEL DO SIMD"; + break; case ST_OMP_PARALLEL_SECTIONS: p = "!$OMP PARALLEL SECTIONS"; break; @@ -1596,12 +1640,18 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_SECTION: p = "!$OMP SECTION"; break; + case ST_OMP_SIMD: + p = "!$OMP SIMD"; + break; case ST_OMP_SINGLE: p = "!$OMP SINGLE"; break; case ST_OMP_TASK: p = "!$OMP TASK"; break; + case ST_OMP_TASKGROUP: + p = "!$OMP TASKGROUP"; + break; case ST_OMP_TASKWAIT: p = "!$OMP TASKWAIT"; break; @@ -3578,7 +3628,19 @@ parse_omp_do (gfc_statement omp_st) pop_state (); st = next_statement (); - if (st == (omp_st == ST_OMP_DO ? ST_OMP_END_DO : ST_OMP_END_PARALLEL_DO)) + gfc_statement omp_end_st = ST_OMP_END_DO; + switch (omp_st) + { + case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break; + case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break; + case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break; + case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break; + case ST_OMP_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD; + break; + default: gcc_unreachable (); + } + if (st == omp_end_st) { if (new_st.op == EXEC_OMP_END_NOWAIT) cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool; @@ -3610,7 +3672,8 @@ parse_omp_atomic (void) np = new_level (cp); np->op = cp->op; np->block = NULL; - count = 1 + (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE); + count = 1 + ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_CAPTURE); while (count) { @@ -3636,7 +3699,8 @@ parse_omp_atomic (void) gfc_warning_check (); st = next_statement (); } - else if (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE) + else if ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_CAPTURE) gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C"); return st; } @@ -3685,6 +3749,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_TASK: omp_end_st = ST_OMP_END_TASK; break; + case ST_OMP_TASKGROUP: + omp_end_st = ST_OMP_END_TASKGROUP; + break; case ST_OMP_WORKSHARE: omp_end_st = ST_OMP_END_WORKSHARE; break; @@ -3744,6 +3811,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) break; case ST_OMP_PARALLEL_DO: + case ST_OMP_PARALLEL_DO_SIMD: st = parse_omp_do (st); continue; @@ -3917,6 +3985,7 @@ parse_executable (gfc_statement st) case ST_OMP_MASTER: case ST_OMP_SINGLE: case ST_OMP_TASK: + case ST_OMP_TASKGROUP: parse_omp_structured_block (st, false); break; @@ -3926,7 +3995,10 @@ parse_executable (gfc_statement st) break; case ST_OMP_DO: + case ST_OMP_DO_SIMD: case ST_OMP_PARALLEL_DO: + case ST_OMP_PARALLEL_DO_SIMD: + case ST_OMP_SIMD: st = parse_omp_do (st); if (st == ST_IMPLIED_ENDDO) return st; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 241b85e4e96..7579573599a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9028,15 +9028,19 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: 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_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_WORKSHARE: @@ -9802,6 +9806,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_TASK: omp_workshare_save = omp_workshare_flag; @@ -9809,6 +9814,8 @@ resolve_code (gfc_code *code, gfc_namespace *ns) gfc_resolve_omp_parallel_blocks (code, ns); break; case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: + case EXEC_OMP_SIMD: gfc_resolve_omp_do_blocks (code, ns); break; case EXEC_SELECT_TYPE: @@ -10128,13 +10135,18 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_WORKSHARE: @@ -10143,6 +10155,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) 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_TASK: @@ -14681,6 +14694,8 @@ resolve_types (gfc_namespace *ns) gfc_resolve_uops (ns->uop_root); + gfc_resolve_omp_declare_simd (ns); + gfc_current_ns = old_ns; } diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 0e1cc705eb4..a3df43ed386 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -185,12 +185,17 @@ gfc_free_statement (gfc_code *p) gfc_free_forall_iterator (p->ext.forall_iterator); break; + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_END_SINGLE: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: case EXEC_OMP_TASK: case EXEC_OMP_WORKSHARE: @@ -203,7 +208,7 @@ gfc_free_statement (gfc_code *p) break; case EXEC_OMP_FLUSH: - gfc_free_namelist (p->ext.omp_namelist); + gfc_free_omp_namelist (p->ext.omp_namelist); break; case EXEC_OMP_ATOMIC: @@ -211,6 +216,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_END_NOWAIT: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: break; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 19d792e0862..3785c2e18eb 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3468,6 +3468,7 @@ gfc_free_namespace (gfc_namespace *ns) free_tb_tree (ns->tb_sym_root); free_tb_tree (ns->tb_uop_root); gfc_free_finalizer_list (ns->finalizers); + gfc_free_omp_declare_simd_list (ns->omp_declare_simd); gfc_free_charlen (ns->cl_list, NULL); free_st_labels (ns->st_labels); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 3972ed36455..5b9661224d0 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1850,6 +1850,11 @@ module_sym: if (DECL_CONTEXT (fndecl) == NULL_TREE) pushdecl_top_level (fndecl); + if (sym->formal_ns + && sym->formal_ns->proc_name == sym + && sym->formal_ns->omp_declare_simd) + gfc_trans_omp_declare_simd (sym->formal_ns); + return fndecl; } @@ -2555,6 +2560,9 @@ gfc_create_function_decl (gfc_namespace * ns, bool global) /* Now create the read argument list. */ create_function_arglist (ns->proc_name); + + if (ns->omp_declare_simd) + gfc_trans_omp_declare_simd (ns); } /* Return the decl used to hold the function return value. If diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 41020a836a7..101dfe5594e 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -427,8 +427,33 @@ gfc_trans_add_clause (tree node, tree tail) } static tree -gfc_trans_omp_variable (gfc_symbol *sym) +gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd) { + if (declare_simd) + { + int cnt = 0; + gfc_symbol *proc_sym; + gfc_formal_arglist *f; + + gcc_assert (sym->attr.dummy); + proc_sym = sym->ns->proc_name; + if (proc_sym->attr.entry_master) + ++cnt; + if (gfc_return_by_reference (proc_sym)) + { + ++cnt; + if (proc_sym->ts.type == BT_CHARACTER) + ++cnt; + } + for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) + if (f->sym == sym) + break; + else if (f->sym) + ++cnt; + gcc_assert (f); + return build_int_cst (integer_type_node, cnt); + } + tree t = gfc_get_symbol_decl (sym); tree parent_decl; int parent_flag; @@ -442,7 +467,8 @@ gfc_trans_omp_variable (gfc_symbol *sym) entry_master = sym->attr.result && sym->ns->proc_name->attr.entry_master && !gfc_return_by_reference (sym->ns->proc_name); - parent_decl = DECL_CONTEXT (current_function_decl); + parent_decl = current_function_decl + ? DECL_CONTEXT (current_function_decl) : NULL_TREE; if ((t == parent_decl && return_value) || (sym->ns && sym->ns->proc_name @@ -481,13 +507,14 @@ gfc_trans_omp_variable (gfc_symbol *sym) } static tree -gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist, - tree list) +gfc_trans_omp_variable_list (enum omp_clause_code code, + gfc_omp_namelist *namelist, tree list, + bool declare_simd) { for (; namelist != NULL; namelist = namelist->next) - if (namelist->sym->attr.referenced) + if (namelist->sym->attr.referenced || declare_simd) { - tree t = gfc_trans_omp_variable (namelist->sym); + tree t = gfc_trans_omp_variable (namelist->sym, declare_simd); if (t != error_mark_node) { tree node = build_omp_clause (input_location, code); @@ -745,13 +772,13 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) } static tree -gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, +gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list, enum tree_code reduction_code, locus where) { for (; namelist != NULL; namelist = namelist->next) if (namelist->sym->attr.referenced) { - tree t = gfc_trans_omp_variable (namelist->sym); + tree t = gfc_trans_omp_variable (namelist->sym, false); if (t != error_mark_node) { tree node = build_omp_clause (where.lb->location, @@ -768,7 +795,7 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, - locus where) + locus where, bool declare_simd = false) { tree omp_clauses = NULL_TREE, chunk_size, c; int list; @@ -780,7 +807,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, for (list = 0; list < OMP_LIST_NUM; list++) { - gfc_namelist *n = clauses->lists[list]; + gfc_omp_namelist *n = clauses->lists[list]; if (n == NULL) continue; @@ -853,10 +880,125 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, goto add_clause; case OMP_LIST_COPYPRIVATE: clause_code = OMP_CLAUSE_COPYPRIVATE; + goto add_clause; + case OMP_LIST_UNIFORM: + clause_code = OMP_CLAUSE_UNIFORM; /* FALLTHROUGH */ add_clause: omp_clauses - = gfc_trans_omp_variable_list (clause_code, n, omp_clauses); + = gfc_trans_omp_variable_list (clause_code, n, omp_clauses, + declare_simd); + break; + case OMP_LIST_ALIGNED: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALIGNED); + OMP_CLAUSE_DECL (node) = t; + if (n->expr) + { + tree alignment_var; + + if (block == NULL) + alignment_var = gfc_conv_constant_to_tree (n->expr); + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + gfc_add_block_to_block (block, &se.pre); + alignment_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; + case OMP_LIST_LINEAR: + { + gfc_expr *last_step_expr = NULL; + tree last_step = NULL_TREE; + + for (; n != NULL; n = n->next) + { + if (n->expr) + { + last_step_expr = n->expr; + last_step = NULL_TREE; + } + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_LINEAR); + OMP_CLAUSE_DECL (node) = t; + if (last_step_expr && last_step == NULL_TREE) + { + if (block == NULL) + last_step + = gfc_conv_constant_to_tree (last_step_expr); + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, last_step_expr); + gfc_add_block_to_block (block, &se.pre); + last_step = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + } + OMP_CLAUSE_LINEAR_STEP (node) = last_step; + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + } + } + break; + case OMP_LIST_DEPEND_IN: + case OMP_LIST_DEPEND_OUT: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.referenced) + continue; + + tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND); + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + { + OMP_CLAUSE_DECL (node) = gfc_get_symbol_decl (n->sym); + if (DECL_P (OMP_CLAUSE_DECL (node))) + TREE_ADDRESSABLE (OMP_CLAUSE_DECL (node)) = 1; + } + else + { + tree ptr; + gfc_init_se (&se, NULL); + if (n->expr->ref->u.ar.type == AR_ELEMENT) + { + gfc_conv_expr_reference (&se, n->expr); + ptr = se.expr; + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + } + gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (block, &se.post); + OMP_CLAUSE_DECL (node) + = fold_build1_loc (input_location, INDIRECT_REF, + TREE_TYPE (TREE_TYPE (ptr)), ptr); + } + OMP_CLAUSE_DEPEND_KIND (node) + = ((list == OMP_LIST_DEPEND_IN) + ? OMP_CLAUSE_DEPEND_IN : OMP_CLAUSE_DEPEND_OUT); + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } break; default: break; @@ -1000,6 +1142,83 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->inbranch) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->notinbranch) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + switch (clauses->cancel) + { + case OMP_CANCEL_UNKNOWN: + break; + case OMP_CANCEL_PARALLEL: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_SECTIONS: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_DO: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_TASKGROUP: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + } + + if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND); + switch (clauses->proc_bind) + { + case OMP_PROC_BIND_MASTER: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER; + break; + case OMP_PROC_BIND_SPREAD: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD; + break; + case OMP_PROC_BIND_CLOSE: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE; + break; + default: + gcc_unreachable (); + } + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->safelen_expr) + { + tree safelen_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->safelen_expr); + gfc_add_block_to_block (block, &se.pre); + safelen_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN); + OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->simdlen_expr) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) + = gfc_conv_constant_to_tree (clauses->simdlen_expr); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + return omp_clauses; } @@ -1045,6 +1264,7 @@ gfc_trans_omp_atomic (gfc_code *code) enum tree_code op = ERROR_MARK; enum tree_code aop = OMP_ATOMIC; bool var_on_left = false; + bool seq_cst = (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) != 0; code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); @@ -1060,7 +1280,7 @@ gfc_trans_omp_atomic (gfc_code *code) && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) expr2 = expr2->value.function.actual->expr; - switch (atomic_code->ext.omp_atomic) + switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) { case GFC_OMP_ATOMIC_READ: gfc_conv_expr (&vse, code->expr1); @@ -1072,6 +1292,7 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = gfc_build_addr_expr (NULL, lse.expr); x = build1 (OMP_ATOMIC_READ, type, lhsaddr); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; x = convert (TREE_TYPE (vse.expr), x); gfc_add_modify (&block, vse.expr, x); @@ -1107,7 +1328,9 @@ gfc_trans_omp_atomic (gfc_code *code) type = TREE_TYPE (lse.expr); lhsaddr = gfc_build_addr_expr (NULL, lse.expr); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_WRITE) + || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) { gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&block, &rse.pre); @@ -1229,7 +1452,9 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = save_expr (lhsaddr); rhs = gfc_evaluate_now (rse.expr, &block); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_WRITE) + || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) x = rhs; else { @@ -1252,6 +1477,7 @@ gfc_trans_omp_atomic (gfc_code *code) if (aop == OMP_ATOMIC) { x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; gfc_add_expr_to_block (&block, x); } else @@ -1273,6 +1499,7 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_add_block_to_block (&block, &lse.pre); } x = build2 (aop, type, lhsaddr, convert (type, x)); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; x = convert (TREE_TYPE (vse.expr), x); gfc_add_modify (&block, vse.expr, x); } @@ -1288,6 +1515,63 @@ gfc_trans_omp_barrier (void) } static tree +gfc_trans_omp_cancel (gfc_code *code) +{ + int mask = 0; + tree ifc = boolean_true_node; + stmtblock_t block; + switch (code->ext.omp_clauses->cancel) + { + case OMP_CANCEL_PARALLEL: mask = 1; break; + case OMP_CANCEL_DO: mask = 2; break; + case OMP_CANCEL_SECTIONS: mask = 4; break; + case OMP_CANCEL_TASKGROUP: mask = 8; break; + default: gcc_unreachable (); + } + gfc_start_block (&block); + if (code->ext.omp_clauses->if_expr) + { + gfc_se se; + tree if_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, code->ext.omp_clauses->if_expr); + gfc_add_block_to_block (&block, &se.pre); + if_var = gfc_evaluate_now (se.expr, &block); + gfc_add_block_to_block (&block, &se.post); + tree type = TREE_TYPE (if_var); + ifc = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, if_var, + build_zero_cst (type)); + } + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL); + tree c_bool_type = TREE_TYPE (TREE_TYPE (decl)); + ifc = fold_convert (c_bool_type, ifc); + gfc_add_expr_to_block (&block, + build_call_expr_loc (input_location, decl, 2, + build_int_cst (integer_type_node, + mask), ifc)); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_cancellation_point (gfc_code *code) +{ + int mask = 0; + switch (code->ext.omp_clauses->cancel) + { + case OMP_CANCEL_PARALLEL: mask = 1; break; + case OMP_CANCEL_DO: mask = 2; break; + case OMP_CANCEL_SECTIONS: mask = 4; break; + case OMP_CANCEL_TASKGROUP: mask = 8; break; + default: gcc_unreachable (); + } + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT); + return build_call_expr_loc (input_location, decl, 1, + build_int_cst (integer_type_node, mask)); +} + +static tree gfc_trans_omp_critical (gfc_code *code) { tree name = NULL_TREE, stmt; @@ -1304,7 +1588,7 @@ typedef struct dovar_init_d { static tree -gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, +gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, gfc_omp_clauses *do_clauses, tree par_clauses) { gfc_se se; @@ -1344,14 +1628,15 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, if (clauses) { - gfc_namelist *n; - for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; - n = n->next) + gfc_omp_namelist *n; + for (n = clauses->lists[(op == EXEC_OMP_SIMD && collapse == 1) + ? OMP_LIST_LINEAR : OMP_LIST_LASTPRIVATE]; + n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; if (n != NULL) dovar_found = 1; - else if (n == NULL) + else if (n == NULL && op != EXEC_OMP_SIMD) for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; @@ -1393,7 +1678,8 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } else dovar_decl - = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym); + = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym, + false); /* Loop body. */ if (simple) @@ -1447,11 +1733,24 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, if (!dovar_found) { - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (op == EXEC_OMP_SIMD) + { + if (collapse == 1) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); + if (!simple) + dovar_found = 2; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); OMP_CLAUSE_DECL (tmp) = dovar_decl; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } - else if (dovar_found == 2) + if (dovar_found == 2) { tree c = NULL; @@ -1475,8 +1774,14 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp; break; } + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR + && OMP_CLAUSE_DECL (c) == dovar_decl) + { + OMP_CLAUSE_LINEAR_STMT (c) = tmp; + break; + } } - if (c == NULL && par_clauses != NULL) + if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL) { for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE @@ -1496,7 +1801,17 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } if (!simple) { - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (op != EXEC_OMP_SIMD) + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + else if (collapse == 1) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1; + OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); OMP_CLAUSE_DECL (tmp) = count; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } @@ -1538,7 +1853,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } /* End of loop body. */ - stmt = make_node (OMP_FOR); + stmt = make_node (op == EXEC_OMP_SIMD ? OMP_SIMD : OMP_FOR); TREE_TYPE (stmt) = void_type_node; OMP_FOR_BODY (stmt) = gfc_finish_block (&body); @@ -1589,37 +1904,219 @@ gfc_trans_omp_parallel (gfc_code *code) return gfc_finish_block (&block); } +enum +{ + GFC_OMP_SPLIT_SIMD, + GFC_OMP_SPLIT_DO, + GFC_OMP_SPLIT_PARALLEL, + GFC_OMP_SPLIT_NUM +}; + +enum +{ + GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD), + GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO), + GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL) +}; + +static void +gfc_split_omp_clauses (gfc_code *code, + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]) +{ + int mask = 0, innermost = 0, i; + memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses)); + switch (code->op) + { + case EXEC_OMP_DO_SIMD: + mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_PARALLEL_DO: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + default: + gcc_unreachable (); + } + if (code->ext.omp_clauses != NULL) + { + if (mask & GFC_OMP_MASK_PARALLEL) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN] + = code->ext.omp_clauses->lists[OMP_LIST_COPYIN]; + clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads + = code->ext.omp_clauses->num_threads; + clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind + = code->ext.omp_clauses->proc_bind; + /* Shared and default clauses are allowed on parallel and teams. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing + = code->ext.omp_clauses->default_sharing; + /* FIXME: This is currently being discussed. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; + } + if (mask & GFC_OMP_MASK_DO) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_DO].ordered + = code->ext.omp_clauses->ordered; + clausesa[GFC_OMP_SPLIT_DO].sched_kind + = code->ext.omp_clauses->sched_kind; + clausesa[GFC_OMP_SPLIT_DO].chunk_size + = code->ext.omp_clauses->chunk_size; + clausesa[GFC_OMP_SPLIT_DO].nowait + = code->ext.omp_clauses->nowait; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_DO].collapse + = code->ext.omp_clauses->collapse; + } + if (mask & GFC_OMP_MASK_SIMD) + { + clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr + = code->ext.omp_clauses->safelen_expr; + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LINEAR] + = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED] + = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED]; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_SIMD].collapse + = code->ext.omp_clauses->collapse; + } + /* Private clause is supported on all constructs but target, + it is enough to put it on the innermost one. For + !$ omp do put it on parallel though, + as that's what we did for OpenMP 3.1. */ + clausesa[innermost == GFC_OMP_SPLIT_DO + ? (int) GFC_OMP_SPLIT_PARALLEL + : innermost].lists[OMP_LIST_PRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; + /* Firstprivate clause is supported on all constructs but + target and simd. Put it on the outermost of those and + duplicate on parallel. */ + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + /* Lastprivate is allowed on do and simd. In + parallel do{, simd} we actually want to put it on + parallel rather than do. */ + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + if (mask & GFC_OMP_MASK_SIMD) + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + /* Reduction is allowed on simd, do, parallel and teams. + Duplicate it on all of them, but omit on do if + parallel is present. */ + for (i = OMP_LIST_REDUCTION_FIRST; i <= OMP_LIST_REDUCTION_LAST; i++) + { + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i] + = code->ext.omp_clauses->lists[i]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[i] + = code->ext.omp_clauses->lists[i]; + if (mask & GFC_OMP_MASK_SIMD) + clausesa[GFC_OMP_SPLIT_SIMD].lists[i] + = code->ext.omp_clauses->lists[i]; + } + } + if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + clausesa[GFC_OMP_SPLIT_DO].nowait = true; +} + static tree -gfc_trans_omp_parallel_do (gfc_code *code) +gfc_trans_omp_do_simd (gfc_code *code, gfc_omp_clauses *clausesa, + tree omp_clauses) { stmtblock_t block, *pblock = NULL; - gfc_omp_clauses parallel_clauses, do_clauses; - tree stmt, omp_clauses = NULL_TREE; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, body, omp_do_clauses = NULL_TREE; gfc_start_block (&block); - memset (&do_clauses, 0, sizeof (do_clauses)); - if (code->ext.omp_clauses != NULL) + if (clausesa == NULL) { - memcpy (¶llel_clauses, code->ext.omp_clauses, - sizeof (parallel_clauses)); - do_clauses.sched_kind = parallel_clauses.sched_kind; - do_clauses.chunk_size = parallel_clauses.chunk_size; - do_clauses.ordered = parallel_clauses.ordered; - do_clauses.collapse = parallel_clauses.collapse; - parallel_clauses.sched_kind = OMP_SCHED_NONE; - parallel_clauses.chunk_size = NULL; - parallel_clauses.ordered = false; - parallel_clauses.collapse = 0; - omp_clauses = gfc_trans_omp_clauses (&block, ¶llel_clauses, - code->loc); + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); } - do_clauses.nowait = true; - if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC) + omp_do_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc); + pblock = █ + body = gfc_trans_omp_do (code, EXEC_OMP_SIMD, pblock, + &clausesa[GFC_OMP_SPLIT_SIMD], omp_clauses); + if (TREE_CODE (body) != BIND_EXPR) + body = build3_v (BIND_EXPR, NULL, body, poplevel (1, 0)); + else + poplevel (0, 0); + stmt = make_node (OMP_FOR); + TREE_TYPE (stmt) = void_type_node; + OMP_FOR_BODY (stmt) = body; + OMP_FOR_CLAUSES (stmt) = omp_do_clauses; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_parallel_do (gfc_code *code) +{ + stmtblock_t block, *pblock = NULL; + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + + gfc_split_omp_clauses (code, clausesa); + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + if (!clausesa[GFC_OMP_SPLIT_DO].ordered + && clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC) pblock = █ else pushlevel (); - stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses); + stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, pblock, + &clausesa[GFC_OMP_SPLIT_DO], omp_clauses); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, + omp_clauses); + OMP_PARALLEL_COMBINED (stmt) = 1; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_parallel_do_simd (gfc_code *code) +{ + stmtblock_t block; + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + + gfc_split_omp_clauses (code, clausesa); + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + pushlevel (); + stmt = gfc_trans_omp_do_simd (code, clausesa, omp_clauses); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -1743,6 +2240,13 @@ gfc_trans_omp_task (gfc_code *code) } static tree +gfc_trans_omp_taskgroup (gfc_code *code) +{ + tree stmt = gfc_trans_code (code->block->next); + return build1_loc (input_location, OMP_TASKGROUP, void_type_node, stmt); +} + +static tree gfc_trans_omp_taskwait (void) { tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT); @@ -1923,10 +2427,18 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_atomic (code); case EXEC_OMP_BARRIER: return gfc_trans_omp_barrier (); + case EXEC_OMP_CANCEL: + return gfc_trans_omp_cancel (code); + case EXEC_OMP_CANCELLATION_POINT: + return gfc_trans_omp_cancellation_point (code); case EXEC_OMP_CRITICAL: return gfc_trans_omp_critical (code); case EXEC_OMP_DO: - return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses, NULL); + case EXEC_OMP_SIMD: + return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, + NULL); + case EXEC_OMP_DO_SIMD: + return gfc_trans_omp_do_simd (code, NULL, NULL_TREE); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (); case EXEC_OMP_MASTER: @@ -1937,6 +2449,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_parallel (code); case EXEC_OMP_PARALLEL_DO: return gfc_trans_omp_parallel_do (code); + case EXEC_OMP_PARALLEL_DO_SIMD: + return gfc_trans_omp_parallel_do_simd (code); case EXEC_OMP_PARALLEL_SECTIONS: return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: @@ -1947,6 +2461,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_single (code, code->ext.omp_clauses); case EXEC_OMP_TASK: return gfc_trans_omp_task (code); + case EXEC_OMP_TASKGROUP: + return gfc_trans_omp_taskgroup (code); case EXEC_OMP_TASKWAIT: return gfc_trans_omp_taskwait (); case EXEC_OMP_TASKYIELD: @@ -1957,3 +2473,22 @@ gfc_trans_omp_directive (gfc_code *code) gcc_unreachable (); } } + +void +gfc_trans_omp_declare_simd (gfc_namespace *ns) +{ + if (ns->entries) + return; + + gfc_omp_declare_simd *ods; + for (ods = ns->omp_declare_simd; ods; ods = ods->next) + { + tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true); + tree fndecl = ns->proc_name->backend_decl; + if (c != NULL_TREE) + c = tree_cons (NULL_TREE, c, NULL_TREE); + c = build_tree_list (get_identifier ("omp declare simd"), c); + TREE_CHAIN (c) = DECL_ATTRIBUTES (fndecl); + DECL_ATTRIBUTES (fndecl) = c; + } +} diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index 8a57be4d577..087bafea4b0 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -63,6 +63,7 @@ tree gfc_trans_deallocate_array (tree); /* trans-openmp.c */ tree gfc_trans_omp_directive (gfc_code *); +void gfc_trans_omp_declare_simd (gfc_namespace *); /* trans-io.c */ tree gfc_trans_open (gfc_code *); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 5961c267e8c..8182da54141 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1848,18 +1848,24 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: 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: 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_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_WORKSHARE: diff --git a/gcc/gimplify.c b/gcc/gimplify.c index be4d71900ac..32416331ac5 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -6069,6 +6069,27 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, gimplify_omp_ctxp = outer_ctx; } + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR + && OMP_CLAUSE_LINEAR_STMT (c)) + { + gimplify_omp_ctxp = ctx; + push_gimplify_context (); + if (TREE_CODE (OMP_CLAUSE_LINEAR_STMT (c)) != BIND_EXPR) + { + tree bind = build3 (BIND_EXPR, void_type_node, NULL, + NULL, NULL); + TREE_SIDE_EFFECTS (bind) = 1; + BIND_EXPR_BODY (bind) = OMP_CLAUSE_LINEAR_STMT (c); + OMP_CLAUSE_LINEAR_STMT (c) = bind; + } + gimplify_and_add (OMP_CLAUSE_LINEAR_STMT (c), + &OMP_CLAUSE_LINEAR_GIMPLE_SEQ (c)); + pop_gimplify_context + (gimple_seq_first_stmt (OMP_CLAUSE_LINEAR_GIMPLE_SEQ (c))); + OMP_CLAUSE_LINEAR_STMT (c) = NULL_TREE; + + gimplify_omp_ctxp = outer_ctx; + } if (notice_outer) goto do_notice; break; diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 453f580a838..ddd2bd563e1 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -3405,8 +3405,8 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist, = gimple_build_assign (unshare_expr (lvar), iv); gsi_insert_before_without_update (&gsi, g, GSI_SAME_STMT); - tree stept = POINTER_TYPE_P (TREE_TYPE (x)) - ? sizetype : TREE_TYPE (x); + tree stept = POINTER_TYPE_P (TREE_TYPE (iv)) + ? sizetype : TREE_TYPE (iv); tree t = fold_convert (stept, OMP_CLAUSE_LINEAR_STEP (c)); enum tree_code code = PLUS_EXPR; @@ -8416,10 +8416,14 @@ maybe_add_implicit_barrier_cancel (omp_context *ctx, gimple_seq *body) && gimple_code (ctx->outer->stmt) == GIMPLE_OMP_PARALLEL && ctx->outer->cancellable) { - tree lhs = create_tmp_var (boolean_type_node, NULL); + tree fndecl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL); + tree c_bool_type = TREE_TYPE (TREE_TYPE (fndecl)); + tree lhs = create_tmp_var (c_bool_type, NULL); gimple_omp_return_set_lhs (omp_return, lhs); tree fallthru_label = create_artificial_label (UNKNOWN_LOCATION); - gimple g = gimple_build_cond (NE_EXPR, lhs, boolean_false_node, + gimple g = gimple_build_cond (NE_EXPR, lhs, + fold_convert (c_bool_type, + boolean_false_node), ctx->outer->cancel_label, fallthru_label); gimple_seq_add_stmt (body, g); gimple_seq_add_stmt (body, gimple_build_label (fallthru_label)); @@ -10125,21 +10129,23 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx) } break; } - tree lhs; - lhs = create_tmp_var (boolean_type_node, NULL); if (DECL_FUNCTION_CODE (fndecl) == BUILT_IN_GOMP_BARRIER) { fndecl = builtin_decl_explicit (BUILT_IN_GOMP_BARRIER_CANCEL); gimple_call_set_fndecl (stmt, fndecl); gimple_call_set_fntype (stmt, TREE_TYPE (fndecl)); } + tree lhs; + lhs = create_tmp_var (TREE_TYPE (TREE_TYPE (fndecl)), NULL); gimple_call_set_lhs (stmt, lhs); tree fallthru_label; fallthru_label = create_artificial_label (UNKNOWN_LOCATION); gimple g; g = gimple_build_label (fallthru_label); gsi_insert_after (gsi_p, g, GSI_SAME_STMT); - g = gimple_build_cond (NE_EXPR, lhs, boolean_false_node, + g = gimple_build_cond (NE_EXPR, lhs, + fold_convert (TREE_TYPE (lhs), + boolean_false_node), cctx->cancel_label, fallthru_label); gsi_insert_after (gsi_p, g, GSI_SAME_STMT); break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 74597966bb7..2afe7e603bc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2014-05-11 Jakub Jelinek <jakub@redhat.com> + + * gfortran.dg/gomp/affinity-1.f90: New test. + 2014-05-11 Richard Sandiford <rdsandiford@googlemail.com> * gcc.dg/torture/pr61136.c: New test. diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 new file mode 100644 index 00000000000..b6e20b9ce63 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 @@ -0,0 +1,19 @@ + integer :: i, j + integer, dimension (10, 10) :: a +!$omp parallel do default(none)proc_bind(master)shared(a) + do i = 1, 10 + j = 4 + do j = 1, 10 + a(i, j) = i + j + end do + j = 8 + end do +!$omp end parallel do +!$omp parallel proc_bind (close) +!$omp parallel default(none) proc_bind (spread) firstprivate(a) private (i) + do i = 1, 10 + a(i, i) = i + enddo +!$omp end parallel +!$omp endparallel +end diff --git a/gcc/tree-nested.c b/gcc/tree-nested.c index 9c175de4e9d..ba2cc765709 100644 --- a/gcc/tree-nested.c +++ b/gcc/tree-nested.c @@ -1112,6 +1112,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_FINAL: case OMP_CLAUSE_IF: case OMP_CLAUSE_NUM_THREADS: + case OMP_CLAUSE_DEPEND: wi->val_only = true; wi->is_lhs = false; convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), @@ -1651,6 +1652,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_FINAL: case OMP_CLAUSE_IF: case OMP_CLAUSE_NUM_THREADS: + case OMP_CLAUSE_DEPEND: wi->val_only = true; wi->is_lhs = false; convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), &dummy, diff --git a/gcc/tree.c b/gcc/tree.c index a578c926923..4655227e660 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -253,7 +253,7 @@ unsigned const char omp_clause_num_ops[] = 4, /* OMP_CLAUSE_REDUCTION */ 1, /* OMP_CLAUSE_COPYIN */ 1, /* OMP_CLAUSE_COPYPRIVATE */ - 2, /* OMP_CLAUSE_LINEAR */ + 3, /* OMP_CLAUSE_LINEAR */ 2, /* OMP_CLAUSE_ALIGNED */ 1, /* OMP_CLAUSE_DEPEND */ 1, /* OMP_CLAUSE_UNIFORM */ @@ -10960,8 +10960,13 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data, WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp)); } - case OMP_CLAUSE_ALIGNED: case OMP_CLAUSE_LINEAR: + WALK_SUBTREE (OMP_CLAUSE_DECL (*tp)); + WALK_SUBTREE (OMP_CLAUSE_LINEAR_STEP (*tp)); + WALK_SUBTREE (OMP_CLAUSE_LINEAR_STMT (*tp)); + WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp)); + + case OMP_CLAUSE_ALIGNED: case OMP_CLAUSE_FROM: case OMP_CLAUSE_TO: case OMP_CLAUSE_MAP: diff --git a/gcc/tree.h b/gcc/tree.h index 3e8e625ab9f..14bbeb13618 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1333,6 +1333,9 @@ extern void protected_set_expr_location (tree, location_t); #define OMP_CLAUSE_LINEAR_STEP(NODE) \ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR), 1) +#define OMP_CLAUSE_LINEAR_STMT(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR), 2) + #define OMP_CLAUSE_LINEAR_GIMPLE_SEQ(NODE) \ (OMP_CLAUSE_CHECK (NODE))->omp_clause.gimple_reduction_init |