diff options
Diffstat (limited to 'gcc')
32 files changed, 2979 insertions, 534 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index b90789edc5d..9e93f793453 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,28 @@ +2016-11-10 Jakub Jelinek <jakub@redhat.com> + + * omp-low.c (lower_omp_target): Fix up argument to is_reference. + (expand_omp_ordered_sink): Handle TREE_PURPOSE of deps being + TRUNC_DIV_EXPR. + * gimplify.c (gimplify_scan_omp_clauses): Likewise. Set + ctx->target_map_scalars_firstprivate on OMP_TARGET even for Fortran. + Remove omp_no_lastprivate callers. Propagate lastprivate on combined + teams distribute parallel for simd even to distribute and teams + construct. For OMP_CLAUSE_DEPEND add missing break at the end of + OMP_CLAUSE_DEPEND_SINK case. + (omp_notice_variable): Use lang_hooks.decls.omp_scalar_p. + (omp_no_lastprivate): Removed. + (gimplify_adjust_omp_clauses): Remove omp_no_lastprivate callers. + (gimplify_omp_for): Likewise. + (computable_teams_clause): Fail for automatic vars from current + function not yet seen in bind expr. + * langhooks.c (lhd_omp_scalar_p): New function. + * langhooks.h (struct lang_hooks_for_decls): Add omp_scalar_p. + * varpool.c (varpool_node::get_create): Set node->offloading + even for DECL_EXTERNAL decls. + * langhooks-def.h (lhd_omp_scalar_p): New prototype. + (LANG_HOOKS_OMP_SCALAR_P): Define. + (LANG_HOOKS_DECLS): Use it. + 2016-11-10 Martin Liska <mliska@suse.cz> PR sanitizer/78270 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9c0db269f1d..f1ea9a3bc62 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,230 @@ +2016-11-10 Jakub Jelinek <jakub@redhat.com> + + * openmp.c (gfc_free_omp_clauses): Free critical_name, grainsize, + hint, num_tasks, priority and if_exprs. + (gfc_match_omp_to_link, gfc_match_omp_depend_sink): New functions. + (enum omp_mask1, enum omp_mask2): New enums. + Change all OMP_CLAUSE_* defines into enum values, and change their + values from ((uint64_t) 1 << bit) to just bit. + (omp_mask, omp_inv_mask): New classes. Add ctors and operators. + (gfc_match_omp_clauses): Change mask argument from uint64_t to + const omp_mask. Assert OMP_MASK1_LAST and OMP_MASK2_LAST are + at most 64. Move delete clause handling to where it + alphabetically belongs. Parse defaultmap, grainsize, hint, + is_device_ptr, nogroup, nowait, num_tasks, priority, simd, threads + and use_device_ptr clauses. Parse if clause modifier. Parse map + clause always modifier, and release and delete kinds. Parse ordered + clause with argument. Parse schedule clause modifiers. Differentiate + device clause parsing based on openacc flag. Guard link clause + parsing with openacc flag. Add support for parsing + linear clause modifiers. Parse depend(source) and depend(sink: ...). + Use gfc_match_omp_to_link for to and link clauses in declare target + construct. + (match_acc): Change mask type from uint64_t to const omp_mask. + (OMP_SINGLE_CLAUSES, OMP_ORDERED_CLAUSES, + OMP_DECLARE_TARGET_CLAUSES, OMP_TASKLOOP_CLAUSES, + OMP_TARGET_ENTER_DATA_CLAUSES, OMP_TARGET_EXIT_DATA_CLAUSES): Define. + (OACC_PARALLEL_CLAUSES, OACC_KERNELS_CLAUSES, OACC_DATA_CLAUSES, + OACC_LOOP_CLAUSES, OACC_HOST_DATA_CLAUSES, OACC_DECLARE_CLAUSES, + OACC_ENTER_DATA_CLAUSES, OACC_EXIT_DATA_CLAUSES, OACC_WAIT_CLAUSES, + OACC_ROUTINE_CLAUSES, OMP_PARALLEL_CLAUSES, OMP_DECLARE_SIMD_CLAUSES, + OMP_SECTIONS_CLAUSES, OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES): + Replace first or only OMP_CLAUSE_* value in bitset with + omp_mask (OMP_CLAUSE_*). + (OMP_DO_CLAUSES): Likewise. Add OMP_CLAUSE_LINEAR. + (OMP_SIMD_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_SIMDLEN. + (OACC_UPDATE_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Replace OMP_CLAUSE_OACC_DEVICE + with OMP_CLAUSE_DEVICE. + (OMP_TASK_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_PRIORITY. + (OMP_TARGET_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_DEPEND, + OMP_CLAUSE_NOWAIT, OMP_CLAUSE_PRIVATE, OMP_CLAUSE_FIRSTPRIVATE, + OMP_CLAUSE_DEFAULTMAP and OMP_CLAUSE_IS_DEVICE_PTR. + (OMP_TARGET_DATA_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_USE_DEVICE_PTR. + (OMP_TARGET_UPDATE_CLAUSES): Replace first or only OMP_CLAUSE_* value + in bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_DEPEND and + OMP_CLAUSE_NOWAIT. + (match_omp): Change mask argument from unsigned int to + const omp_mask. + (gfc_match_omp_critical): Parse optional clauses and use omp_clauses + union member instead of omp_name. + (gfc_match_omp_end_critical): New function. + (gfc_match_omp_distribute_parallel_do): Remove ordered and linear + clauses from the mask. + (gfc_match_omp_distribute_parallel_do_simd): Use + & ~(omp_mask (OMP_CLAUSE_*)) instead of & ~OMP_CLAUSE_*. + (gfc_match_omp_target_teams_distribute_parallel_do_simd): Likewise. + (gfc_match_omp_teams_distribute_parallel_do_simd): Likewise. + (gfc_match_omp_do_simd): Likewise. Don't remove ordered clause from + the mask. + (gfc_match_omp_parallel_do_simd): Likewise. + (gfc_match_omp_target_teams_distribute_parallel_do): Likewise. + (gfc_match_omp_teams_distribute_parallel_do): Likewise. + (gfc_match_omp_declare_simd): If not using the form with + (proc-name), require space before first clause. Make (proc-name) + optional. If not present, set proc_name to NULL. + (gfc_match_omp_declare_target): Rewritten for OpenMP 4.5. + (gfc_match_omp_single): Use OMP_SINGLE_CLAUSES. + (gfc_match_omp_task, gfc_match_omp_taskwait, gfc_match_omp_taskyield): + Move around to where they belong alphabetically. + (gfc_match_omp_target_enter_data, gfc_match_omp_target_exit_data, + gfc_match_omp_target_parallel, gfc_match_omp_target_parallel_do, + gfc_match_omp_target_parallel_do_simd, gfc_match_omp_target_simd, + gfc_match_omp_taskloop, gfc_match_omp_taskloop_simd): + New functions. + (gfc_match_omp_ordered): Parse clauses. + (gfc_match_omp_ordered_depend): New function. + (gfc_match_omp_cancel, gfc_match_omp_end_single): Use + omp_mask (OMP_CLAUSE_*) instead of OMP_CLAUSE_*. + (resolve_oacc_scalar_int_expr): Renamed to ... + (resolve_scalar_int_expr): ... this. Fix up formatting. + (resolve_oacc_positive_int_expr): Renamed to ... + (resolve_positive_int_expr): ... this. Fix up formatting. + (resolve_nonnegative_int_expr): New function. + (resolve_omp_clauses): Adjust callers, use the above functions + even for OpenMP clauses, add handling of new OpenMP 4.5 clauses. + Require orderedc >= collapse if specified. Handle depend(sink:) + and depend(source) restrictions. Disallow linear clause when + orderedc is non-zero. Diagnose linear clause modifiers when not in + declare simd. Only check for integer type if ref modifier + is not used. Remove diagnostics for required VALUE attribute. + Diagnose VALUE attribute with ref or uval modifiers. Allow + non-constant linear-step, if it is a dummy argument alone and is + mentioned in uniform clause. Diagnose map kinds not allowed + for various constructs. Diagnose target {enter ,exit ,}data without + any map clauses. Add dummy OMP_LIST_IS_DEVICE_PTR and + OMP_LIST_USE_DEVICE_PTR cases. + (gfc_resolve_omp_do_blocks): Set omp_current_do_collapse to orderedc + if non-zero. + (gfc_resolve_omp_parallel_blocks): Handle new OpenMP 4.5 constructs, + replace underscores with spaces in a few construct names. + (resolve_omp_do): Set collapse to orderedc if non-zero. Handle new + OpenMP 4.5 constructs. + (resolve_oacc_loop_blocks): Call resolve_positive_int_expr instead + of resolve_oacc_positive_int_expr. + (gfc_resolve_omp_directive): Handle new OpenMP 4.5 constructs. + (gfc_resolve_omp_declare_simd): Allow ods->proc_name to be NULL. + * trans-openmp.c (gfc_omp_scalar_p): New function. + (doacross_steps): New variable. + (gfc_trans_omp_clauses): Handle new OpenMP 4.5 clauses and new clause + modifiers. + (gfc_trans_omp_critical): Adjust EXEC_OMP_CRITICAL handling. + (gfc_trans_omp_do): Handle doacross loops. Clear sched_simd flag. + Handle EXEC_OMP_TASKLOOP. + (gfc_trans_omp_ordered): Translate omp clauses, allow NULL + code->block. + (GFC_OMP_SPLIT_TASKLOOP, GFC_OMP_MASK_TASKLOOP): New enum constants. + (gfc_split_omp_clauses): Copy orderedc together with ordered. Change + firstprivate and lastprivate handling for OpenMP 4.5. + Handle EXEC_OMP_TARGET_SIMD, EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} + and EXEC_OMP_TASKLOOP{,_SIMD}. Add handling for new OpenMP 4.5 + clauses and clause modifiers and handle if clause without/with + modifiers. + (gfc_trans_omp_teams): Add omp_clauses argument, add it to other + teams clauses. Don't wrap into OMP_TEAMS if -fopenmp-simd. + (gfc_trans_omp_target): For -fopenmp, translate num_teams and + thread_limit clauses on combined target teams early and pass to + gfc_trans_omp_teams. Set OMP_TARGET_COMBINED if needed. + Handle EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} and + EXEC_OMP_TARGET_SIMD. + (gfc_trans_omp_taskloop, gfc_trans_omp_target_enter_data, + gfc_trans_omp_target_exit_data): New functions. + (gfc_trans_omp_directive): Handle EXEC_OMP_TARGET_{ENTER,EXIT}_DATA + EXEC_OMP_TASKLOOP{,_SIMD}, EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} + and EXEC_OMP_TARGET_SIMD. Adjust gfc_trans_omp_teams caller. + * symbol.c (check_conflict): Handle omp_declare_target_link. + (gfc_add_omp_declare_target_link): New function. + (gfc_copy_attr): Copy omp_declare_target_link. + * dump-parse-tree.c (show_omp_namelist): Handle OMP_DEPEND_SINK_FIRST + depend_op. Print linear clause modifiers. + (show_omp_clauses): Adjust for OpenMP 4.5 clause changes. + (show_omp_node): Print clauses for EXEC_OMP_ORDERED. Allow NULL + c->block for EXEC_OMP_ORDERED. Formatting fixes. Adjust handling of + EXEC_OMP_CRITICAL, handle new OpenMP 4.5 constructs and some + forgotten OpenMP 4.0 constructs. + (show_code_node): Handle new OpenMP 4.5 constructs and some forgotten + OpenMP 4.0 constructs. + * gfortran.h (symbol_attribute): Add omp_declare_target_link bitfield. + (struct gfc_omp_namelist): Add u.common and u.linear_op fields. + (struct gfc_common_head): Change omp_declare_target into bitfield. + Add omp_declare_target_link bitfield. + (gfc_add_omp_declare_target_link): New prototype. + (enum gfc_statement): Add ST_OMP_TARGET_PARALLEL, + ST_OMP_END_TARGET_PARALLEL, ST_OMP_TARGET_PARALLEL_DO, + ST_OMP_END_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, + ST_OMP_END_TARGET_PARALLEL_DO_SIMD, ST_OMP_TARGET_ENTER_DATA, + ST_OMP_TARGET_EXIT_DATA, ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, + ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_TASKLOOP_SIMD, + ST_OMP_END_TASKLOOP_SIMD and ST_OMP_ORDERED_DEPEND. + (enum gfc_omp_depend_op): Add OMP_DEPEND_SINK_FIRST and + OMP_DEPEND_SINK. + (enum gfc_omp_linear_op): New. + (struct gfc_omp_clauses): Add critical_name, depend_source, + orderedc, defaultmap, nogroup, sched_simd, sched_monotonic, + sched_nonmonotonic, simd, threads, grainsize, hint, num_tasks, + priority and if_exprs fields. + (enum gfc_exec_op): Add EXEC_OMP_END_CRITICAL, + EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, + EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, + EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, + EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD. + (enum gfc_omp_map_op): Add OMP_MAP_RELEASE, + OMP_MAP_ALWAYS_TO, OMP_MAP_ALWAYS_FROM and OMP_MAP_ALWAYS_TOFROM. + (OMP_LIST_IS_DEVICE_PTR, OMP_LIST_USE_DEVICE_PTR): New. + (enum gfc_omp_if_kind): New. + * module.c (enum ab_attribute): Add AB_OMP_DECLARE_TARGET_LINK. + (attr_bits): Add AB_OMP_DECLARE_TARGET_LINK entry. + (mio_symbol_attribute): Save and restore omp_declare_target_link bit. + * trans.h (gfc_omp_scalar_p): New prototype. + * frontend-passes.c (gfc_code_walker): Handle new OpenMP 4.5 + expressions. + * trans.c (trans_code): Handle new OpenMP 4.5 constructs. + * resolve.c (gfc_resolve_blocks): Likewise. + (gfc_resolve_code): Likewise. + * f95-lang.c (LANG_HOOKS_OMP_SCALAR_P): Redefine to gfc_omp_scalar_p. + (gfc_attribute_table): Add "omp declare target link". + * st.c (gfc_free_statement): Handle EXEC_OMP_END_CRITICAL like + EXEC_OMP_CRITICAL before, free clauses for EXEC_OMP_CRITICAL + and new OpenMP 4.5 constructs. Free omp clauses even for + EXEC_OMP_ORDERED. + * match.c (match_exit_cycle): Rename collapse variable to count, + set it to orderedc if non-zero, instead of collapse. + * trans-decl.c (add_attributes_to_decl): Add "omp declare target link" + instead of "omp declare target" for omp_declare_target_link. + * trans-common.c (build_common_decl): Likewise. + * match.h (gfc_match_omp_target_enter_data, + gfc_match_omp_target_exit_data, gfc_match_omp_target_parallel, + gfc_match_omp_target_parallel_do, + gfc_match_omp_target_parallel_do_simd, gfc_match_omp_target_simd, + gfc_match_omp_taskloop, gfc_match_omp_taskloop_simd, + gfc_match_omp_end_critical, gfc_match_omp_ordered_depend): New + prototypes. + * parse.c (decode_omp_directive): Use gfc_match_omp_end_critical + instead of gfc_match_omp_critical for !$omp end critical. + Handle new OpenMP 4.5 constructs. If ordered directive has + depend clause as the first of the clauses, use + gfc_match_omp_ordered_depend and ST_OMP_ORDERED_DEPEND instead of + gfc_match_omp_ordered and ST_OMP_ORDERED. + (case_executable): Add ST_OMP_TARGET_ENTER_DATA, + ST_OMP_TARGET_EXIT_DATA and ST_OMP_ORDERED_DEPEND cases. + (case_exec_markers): Add ST_OMP_TARGET_PARALLEL, + ST_OMP_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, + ST_OMP_TARGET_SIMD, ST_OMP_TASKLOOP and ST_OMP_TASKLOOP_SIMD cases. + (gfc_ascii_statement): Handle new OpenMP 4.5 constructs. + (parse_omp_do): Handle ST_OMP_TARGET_PARALLEL_DO, + ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_TASKLOOP and + ST_OMP_TASKLOOP_SIMD. + (parse_omp_structured_block): Handle EXEC_OMP_END_CRITICAL instead + of EXEC_OMP_CRITICAL, adjust for EXEC_OMP_CRITICAL having omp clauses + now. + (parse_executable): Handle ST_OMP_TARGET_PARALLEL, + ST_OMP_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, + ST_OMP_TASKLOOP and ST_OMP_TASKLOOP_SIMD. + 2016-11-09 Mikael Morin <mikael@gcc.gnu.org> Janus Weil <janus@gcc.gnu.org> diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 33a28424244..ff47f3fe853 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1059,6 +1059,27 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_DEPEND_IN: fputs ("in:", dumpfile); break; case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break; case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break; + case OMP_DEPEND_SINK_FIRST: + fputs ("sink:", dumpfile); + while (1) + { + fprintf (dumpfile, "%s", n->sym->name); + if (n->expr) + { + fputc ('+', dumpfile); + show_expr (n->expr); + } + if (n->next == NULL) + break; + else if (n->next->u.depend_op != OMP_DEPEND_SINK) + { + fputs (") DEPEND(", dumpfile); + break; + } + fputc (',', dumpfile); + n = n->next; + } + continue; default: break; } else if (list_type == OMP_LIST_MAP) @@ -1070,7 +1091,17 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break; default: break; } + else if (list_type == OMP_LIST_LINEAR) + switch (n->u.linear_op) + { + case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break; + case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break; + case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break; + default: break; + } fprintf (dumpfile, "%s", n->sym->name); + if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT) + fputc (')', dumpfile); if (n->expr) { fputc (':', dumpfile); @@ -1087,7 +1118,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) static void show_omp_clauses (gfc_omp_clauses *omp_clauses) { - int list_type; + int list_type, i; switch (omp_clauses->cancel) { @@ -1209,7 +1240,20 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) default: gcc_unreachable (); } - fprintf (dumpfile, " SCHEDULE (%s", type); + fputs (" SCHEDULE (", dumpfile); + if (omp_clauses->sched_simd) + { + if (omp_clauses->sched_monotonic + || omp_clauses->sched_nonmonotonic) + fputs ("SIMD, ", dumpfile); + else + fputs ("SIMD: ", dumpfile); + } + if (omp_clauses->sched_monotonic) + fputs ("MONOTONIC: ", dumpfile); + else if (omp_clauses->sched_nonmonotonic) + fputs ("NONMONOTONIC: ", dumpfile); + fputs (type, dumpfile); if (omp_clauses->chunk_size) { fputc (',', dumpfile); @@ -1260,7 +1304,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) if (omp_clauses->independent) fputs (" INDEPENDENT", dumpfile); if (omp_clauses->ordered) - fputs (" ORDERED", dumpfile); + { + if (omp_clauses->orderedc) + fprintf (dumpfile, " ORDERED(%d)", omp_clauses->orderedc); + else + fputs (" ORDERED", dumpfile); + } if (omp_clauses->untied) fputs (" UNTIED", dumpfile); if (omp_clauses->mergeable) @@ -1286,6 +1335,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_ALIGNED: type = "ALIGNED"; break; case OMP_LIST_LINEAR: type = "LINEAR"; break; case OMP_LIST_REDUCTION: type = "REDUCTION"; break; + case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break; + case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_DEPEND: type = "DEPEND"; break; default: gcc_unreachable (); @@ -1343,7 +1394,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE) { - fprintf (dumpfile, " DIST_SCHEDULE (static"); + fprintf (dumpfile, " DIST_SCHEDULE (STATIC"); if (omp_clauses->dist_chunk_size) { fputc (',', dumpfile); @@ -1351,6 +1402,59 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fputc (')', dumpfile); } + if (omp_clauses->defaultmap) + fputs (" DEFALTMAP (TOFROM: SCALAR)", dumpfile); + if (omp_clauses->nogroup) + fputs (" NOGROUP", dumpfile); + if (omp_clauses->simd) + fputs (" SIMD", dumpfile); + if (omp_clauses->threads) + fputs (" THREADS", dumpfile); + if (omp_clauses->grainsize) + { + fputs (" GRAINSIZE(", dumpfile); + show_expr (omp_clauses->grainsize); + fputc (')', dumpfile); + } + if (omp_clauses->hint) + { + fputs (" HINT(", dumpfile); + show_expr (omp_clauses->hint); + fputc (')', dumpfile); + } + if (omp_clauses->num_tasks) + { + fputs (" NUM_TASKS(", dumpfile); + show_expr (omp_clauses->num_tasks); + fputc (')', dumpfile); + } + if (omp_clauses->priority) + { + fputs (" PRIORITY(", dumpfile); + show_expr (omp_clauses->priority); + fputc (')', dumpfile); + } + for (i = 0; i < OMP_IF_LAST; i++) + if (omp_clauses->if_exprs[i]) + { + static const char *ifs[] = { + "PARALLEL", + "TASK", + "TASKLOOP", + "TARGET", + "TARGET DATA", + "TARGET UPDATE", + "TARGET ENTER DATA", + "TARGET EXIT DATA" + }; + fputs (" IF(", dumpfile); + fputs (ifs[i], dumpfile); + fputs (": ", dumpfile); + show_expr (omp_clauses->if_exprs[i]); + fputc (')', dumpfile); + } + if (omp_clauses->depend_source) + fputs (" DEPEND(source)", dumpfile); } /* Show a single OpenMP or OpenACC directive node and everything underneath it @@ -1365,7 +1469,8 @@ show_omp_node (int level, gfc_code *c) switch (c->op) { - case EXEC_OACC_PARALLEL_LOOP: name = "PARALLEL LOOP"; is_oacc = true; break; + case EXEC_OACC_PARALLEL_LOOP: + name = "PARALLEL LOOP"; is_oacc = true; break; case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break; case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break; case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break; @@ -1382,9 +1487,15 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_CANCEL: name = "CANCEL"; break; case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; break; case EXEC_OMP_CRITICAL: name = "CRITICAL"; break; - case EXEC_OMP_FLUSH: name = "FLUSH"; break; + case EXEC_OMP_DISTRIBUTE: name = "DISTRIBUTE"; break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + name = "DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break; case EXEC_OMP_DO: name = "DO"; break; case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break; + case EXEC_OMP_FLUSH: name = "FLUSH"; break; case EXEC_OMP_MASTER: name = "MASTER"; break; case EXEC_OMP_ORDERED: name = "ORDERED"; break; case EXEC_OMP_PARALLEL: name = "PARALLEL"; break; @@ -1395,10 +1506,38 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; + case EXEC_OMP_TARGET: name = "TARGET"; break; + case EXEC_OMP_TARGET_DATA: name = "TARGET DATA"; break; + case EXEC_OMP_TARGET_ENTER_DATA: name = "TARGET ENTER DATA"; break; + case EXEC_OMP_TARGET_EXIT_DATA: name = "TARGET EXIT DATA"; break; + case EXEC_OMP_TARGET_PARALLEL: name = "TARGET PARALLEL"; break; + case EXEC_OMP_TARGET_PARALLEL_DO: name = "TARGET PARALLEL DO"; break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + name = "TARGET_PARALLEL_DO_SIMD"; break; + case EXEC_OMP_TARGET_SIMD: name = "TARGET SIMD"; break; + case EXEC_OMP_TARGET_TEAMS: name = "TARGET TEAMS"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + name = "TARGET TEAMS DISTRIBUTE"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "TARGET TEAMS DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + name = "TARGET TEAMS DISTRIBUTE SIMD"; break; + case EXEC_OMP_TARGET_UPDATE: name = "TARGET UPDATE"; break; case EXEC_OMP_TASK: name = "TASK"; break; case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break; + case EXEC_OMP_TASKLOOP: name = "TASKLOOP"; break; + case EXEC_OMP_TASKLOOP_SIMD: name = "TASKLOOP SIMD"; break; case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break; case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break; + case EXEC_OMP_TEAMS: name = "TEAMS"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE: name = "TEAMS DISTRIBUTE"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "TEAMS DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; default: gcc_unreachable (); @@ -1420,23 +1559,50 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_EXIT_DATA: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: - case EXEC_OMP_WORKSHARE: - case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_WORKSHARE: omp_clauses = c->ext.omp_clauses; break; case EXEC_OMP_CRITICAL: - if (c->ext.omp_name) - fprintf (dumpfile, " (%s)", c->ext.omp_name); + omp_clauses = c->ext.omp_clauses; + if (omp_clauses) + fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name); break; case EXEC_OMP_FLUSH: if (c->ext.omp_namelist) @@ -1457,9 +1623,12 @@ show_omp_node (int level, gfc_code *c) show_omp_clauses (omp_clauses); fputc ('\n', dumpfile); - /* OpenACC executable directives don't have associated blocks. */ + /* OpenMP and OpenACC executable directives don't have associated blocks. */ if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE - || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA) + || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA + || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA + || c->op == EXEC_OMP_TARGET_EXIT_DATA + || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) { @@ -1493,8 +1662,8 @@ show_omp_node (int level, gfc_code *c) else if (omp_clauses->nowait) fputs (" NOWAIT", dumpfile); } - else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name) - fprintf (dumpfile, " (%s)", c->ext.omp_name); + else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses) + fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name); } @@ -2520,9 +2689,13 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: - case EXEC_OMP_FLUSH: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_FLUSH: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: @@ -2533,10 +2706,31 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: show_omp_node (level, c); break; diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 2b58173450a..cea6675d53a 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -92,6 +92,8 @@ static const struct attribute_spec gfc_attribute_table[] = affects_type_identity } */ { "omp declare target", 0, 0, true, false, false, gfc_handle_omp_declare_target_attribute, false }, + { "omp declare target link", 0, 0, true, false, false, + gfc_handle_omp_declare_target_attribute, false }, { "oacc function", 0, -1, true, false, false, gfc_handle_omp_declare_target_attribute, false }, { NULL, 0, 0, false, false, false, NULL, false } @@ -119,6 +121,7 @@ static const struct attribute_spec gfc_attribute_table[] = #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR #undef LANG_HOOKS_OMP_CLAUSE_DTOR #undef LANG_HOOKS_OMP_FINISH_CLAUSE +#undef LANG_HOOKS_OMP_SCALAR_P #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF @@ -150,6 +153,7 @@ static const struct attribute_spec gfc_attribute_table[] = #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor #define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause +#define LANG_HOOKS_OMP_SCALAR_P gfc_omp_scalar_p #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 1ad797b579c..44d2a4218b7 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -3647,18 +3647,28 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, /* Fall through */ + case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_END_SINGLE: case EXEC_OMP_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -3694,6 +3704,12 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->device); WALK_SUBEXPR (co->ext.omp_clauses->thread_limit); WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size); + WALK_SUBEXPR (co->ext.omp_clauses->grainsize); + WALK_SUBEXPR (co->ext.omp_clauses->hint); + WALK_SUBEXPR (co->ext.omp_clauses->num_tasks); + WALK_SUBEXPR (co->ext.omp_clauses->priority); + for (idx = 0; idx < OMP_IF_LAST; idx++) + WALK_SUBEXPR (co->ext.omp_clauses->if_exprs[idx]); for (idx = 0; idx < sizeof (list_types) / sizeof (list_types[0]); idx++) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3fb6f4152ce..7956630f61d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -254,6 +254,13 @@ enum gfc_statement ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_TARGET_PARALLEL, ST_OMP_END_TARGET_PARALLEL, + ST_OMP_TARGET_PARALLEL_DO, ST_OMP_END_TARGET_PARALLEL_DO, + ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD, + ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA, + ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, + ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, + ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, ST_EVENT_WAIT,ST_NONE @@ -865,6 +872,7 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; + unsigned omp_declare_target_link:1; /* Mentioned in OACC DECLARE. */ unsigned oacc_declare_create:1; @@ -1128,7 +1136,9 @@ enum gfc_omp_depend_op { OMP_DEPEND_IN, OMP_DEPEND_OUT, - OMP_DEPEND_INOUT + OMP_DEPEND_INOUT, + OMP_DEPEND_SINK_FIRST, + OMP_DEPEND_SINK }; enum gfc_omp_map_op @@ -1145,7 +1155,19 @@ enum gfc_omp_map_op OMP_MAP_FORCE_PRESENT, OMP_MAP_FORCE_DEVICEPTR, OMP_MAP_DEVICE_RESIDENT, - OMP_MAP_LINK + OMP_MAP_LINK, + OMP_MAP_RELEASE, + OMP_MAP_ALWAYS_TO, + OMP_MAP_ALWAYS_FROM, + OMP_MAP_ALWAYS_TOFROM +}; + +enum gfc_omp_linear_op +{ + OMP_LINEAR_DEFAULT, + OMP_LINEAR_REF, + OMP_LINEAR_VAL, + OMP_LINEAR_UVAL }; /* For use in OpenMP clauses in case we need extra information @@ -1160,6 +1182,8 @@ typedef struct gfc_omp_namelist gfc_omp_reduction_op reduction_op; gfc_omp_depend_op depend_op; gfc_omp_map_op map_op; + gfc_omp_linear_op linear_op; + struct gfc_common_head *common; } u; struct gfc_omp_namelist_udr *udr; struct gfc_omp_namelist *next; @@ -1190,6 +1214,8 @@ enum OMP_LIST_LINK, OMP_LIST_USE_DEVICE, OMP_LIST_CACHE, + OMP_LIST_IS_DEVICE_PTR, + OMP_LIST_USE_DEVICE_PTR, OMP_LIST_NUM }; @@ -1232,6 +1258,19 @@ enum gfc_omp_cancel_kind OMP_CANCEL_TASKGROUP }; +enum gfc_omp_if_kind +{ + OMP_IF_PARALLEL, + OMP_IF_TASK, + OMP_IF_TASKLOOP, + OMP_IF_TARGET, + OMP_IF_TARGET_DATA, + OMP_IF_TARGET_UPDATE, + OMP_IF_TARGET_ENTER_DATA, + OMP_IF_TARGET_EXIT_DATA, + OMP_IF_LAST +}; + typedef struct gfc_omp_clauses { struct gfc_expr *if_expr; @@ -1241,9 +1280,11 @@ typedef struct gfc_omp_clauses enum gfc_omp_sched_kind sched_kind; struct gfc_expr *chunk_size; enum gfc_omp_default_sharing default_sharing; - int collapse; + int collapse, orderedc; bool nowait, ordered, untied, mergeable; - bool inbranch, notinbranch; + bool inbranch, notinbranch, defaultmap, nogroup; + bool sched_simd, sched_monotonic, sched_nonmonotonic; + bool simd, threads, depend_source; enum gfc_omp_cancel_kind cancel; enum gfc_omp_proc_bind_kind proc_bind; struct gfc_expr *safelen_expr; @@ -1251,8 +1292,14 @@ typedef struct gfc_omp_clauses struct gfc_expr *num_teams; struct gfc_expr *device; struct gfc_expr *thread_limit; + struct gfc_expr *grainsize; + struct gfc_expr *hint; + struct gfc_expr *num_tasks; + struct gfc_expr *priority; + struct gfc_expr *if_exprs[OMP_IF_LAST]; enum gfc_omp_sched_kind dist_sched_kind; struct gfc_expr *dist_chunk_size; + const char *critical_name; /* OpenACC. */ struct gfc_expr *async_expr; @@ -1541,7 +1588,9 @@ struct gfc_undo_change_set typedef struct gfc_common_head { locus where; - char use_assoc, saved, threadprivate, omp_declare_target; + char use_assoc, saved, threadprivate; + unsigned char omp_declare_target : 1; + unsigned char omp_declare_target_link : 1; char name[GFC_MAX_SYMBOL_LEN + 1]; struct gfc_symbol *head; const char* binding_label; @@ -2424,7 +2473,11 @@ enum gfc_exec_op EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, - EXEC_OMP_TARGET_UPDATE + EXEC_OMP_TARGET_UPDATE, EXEC_OMP_END_CRITICAL, + EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, + EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, + EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, + EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD }; enum gfc_omp_atomic_op @@ -2823,6 +2876,8 @@ bool gfc_add_automatic (symbol_attribute *, const char *, locus *); bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *); bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *); bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *); +bool gfc_add_omp_declare_target_link (symbol_attribute *, const char *, + locus *); bool gfc_add_saved_common (symbol_attribute *, locus *); bool gfc_add_target (symbol_attribute *, locus *); bool gfc_add_dummy (symbol_attribute *, const char *, locus *); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 5a7451ec9c4..523cba45c7e 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2787,21 +2787,25 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) || o->head->op == EXEC_OMP_DO_SIMD || o->head->op == EXEC_OMP_PARALLEL_DO_SIMD)) { - int collapse = 1; + int count = 1; gcc_assert (o->head->next != NULL && (o->head->next->op == EXEC_DO || o->head->next->op == EXEC_DO_WHILE) && o->previous != NULL && o->previous->tail->op == o->head->op); - if (o->previous->tail->ext.omp_clauses != NULL - && o->previous->tail->ext.omp_clauses->collapse > 1) - collapse = o->previous->tail->ext.omp_clauses->collapse; - if (st == ST_EXIT && cnt <= collapse) + if (o->previous->tail->ext.omp_clauses != NULL) + { + if (o->previous->tail->ext.omp_clauses->collapse > 1) + count = o->previous->tail->ext.omp_clauses->collapse; + if (o->previous->tail->ext.omp_clauses->orderedc) + count = o->previous->tail->ext.omp_clauses->orderedc; + } + if (st == ST_EXIT && cnt <= count) { gfc_error ("EXIT statement at %C terminating !$OMP DO loop"); return MATCH_ERROR; } - if (st == ST_CYCLE && cnt < collapse) + if (st == ST_CYCLE && cnt < count) { gfc_error ("CYCLE statement at %C to non-innermost collapsed" " !$OMP DO loop"); diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index eeb26931567..e87e939a812 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -162,6 +162,7 @@ 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_ordered_depend (void); match gfc_match_omp_parallel (void); match gfc_match_omp_parallel_do (void); match gfc_match_omp_parallel_do_simd (void); @@ -172,6 +173,12 @@ match gfc_match_omp_simd (void); match gfc_match_omp_single (void); match gfc_match_omp_target (void); match gfc_match_omp_target_data (void); +match gfc_match_omp_target_enter_data (void); +match gfc_match_omp_target_exit_data (void); +match gfc_match_omp_target_parallel (void); +match gfc_match_omp_target_parallel_do (void); +match gfc_match_omp_target_parallel_do_simd (void); +match gfc_match_omp_target_simd (void); match gfc_match_omp_target_teams (void); match gfc_match_omp_target_teams_distribute (void); match gfc_match_omp_target_teams_distribute_parallel_do (void); @@ -180,6 +187,8 @@ match gfc_match_omp_target_teams_distribute_simd (void); match gfc_match_omp_target_update (void); match gfc_match_omp_task (void); match gfc_match_omp_taskgroup (void); +match gfc_match_omp_taskloop (void); +match gfc_match_omp_taskloop_simd (void); match gfc_match_omp_taskwait (void); match gfc_match_omp_taskyield (void); match gfc_match_omp_teams (void); @@ -189,6 +198,7 @@ match gfc_match_omp_teams_distribute_parallel_do_simd (void); match gfc_match_omp_teams_distribute_simd (void); match gfc_match_omp_threadprivate (void); match gfc_match_omp_workshare (void); +match gfc_match_omp_end_critical (void); match gfc_match_omp_end_nowait (void); match gfc_match_omp_end_single (void); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 4d664f079f5..4116db8ecad 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -1988,7 +1988,8 @@ enum ab_attribute AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET, AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE, AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR, - AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK + AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK, + AB_OMP_DECLARE_TARGET_LINK }; static const mstring attr_bits[] = @@ -2051,6 +2052,7 @@ static const mstring attr_bits[] = minit ("OACC_DECLARE_DEVICEPTR", AB_OACC_DECLARE_DEVICEPTR), minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT), minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK), + minit ("OMP_DECLARE_TARGET_LINK", AB_OMP_DECLARE_TARGET_LINK), minit (NULL, -1) }; @@ -2250,6 +2252,8 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICE_RESIDENT, attr_bits); if (attr->oacc_declare_link) MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits); + if (attr->omp_declare_target_link) + MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET_LINK, attr_bits); mio_rparen (); @@ -2419,6 +2423,9 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_OMP_DECLARE_TARGET: attr->omp_declare_target = 1; break; + case AB_OMP_DECLARE_TARGET_LINK: + attr->omp_declare_target_link = 1; + break; case AB_ARRAY_OUTER_DEPENDENCY: attr->array_outer_dependency =1; break; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 03e7dbe2f37..11ffb5d884c 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -76,6 +76,12 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->device); gfc_free_expr (c->thread_limit); gfc_free_expr (c->dist_chunk_size); + gfc_free_expr (c->grainsize); + gfc_free_expr (c->hint); + gfc_free_expr (c->num_tasks); + gfc_free_expr (c->priority); + for (i = 0; i < OMP_IF_LAST; i++) + gfc_free_expr (c->if_exprs[i]); gfc_free_expr (c->async_expr); gfc_free_expr (c->gang_num_expr); gfc_free_expr (c->gang_static_expr); @@ -88,6 +94,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_omp_namelist (c->lists[i]); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); + free (CONST_CAST (char *, c->critical_name)); free (c); } @@ -333,6 +340,170 @@ cleanup: return MATCH_ERROR; } +/* Match a variable/procedure/common block list and construct a namelist + from it. */ + +static match +gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list) +{ + gfc_omp_namelist *head, *tail, *p; + locus old_loc, cur_loc; + char n[GFC_MAX_SYMBOL_LEN+1]; + gfc_symbol *sym; + match m; + gfc_symtree *st; + + head = tail = NULL; + + old_loc = gfc_current_locus; + + m = gfc_match (str); + if (m != MATCH_YES) + return m; + + for (;;) + { + cur_loc = gfc_current_locus; + m = gfc_match_symbol (&sym, 1); + switch (m) + { + case MATCH_YES: + p = gfc_get_omp_namelist (); + if (head == NULL) + head = tail = p; + else + { + tail->next = p; + tail = tail->next; + } + tail->sym = sym; + tail->where = cur_loc; + goto next_item; + case MATCH_NO: + break; + case MATCH_ERROR: + goto cleanup; + } + + m = gfc_match (" / %n /", n); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO) + goto syntax; + + st = gfc_find_symtree (gfc_current_ns->common_root, n); + if (st == NULL) + { + gfc_error ("COMMON block /%s/ not found at %C", n); + goto cleanup; + } + p = gfc_get_omp_namelist (); + if (head == NULL) + head = tail = p; + else + { + tail->next = p; + tail = tail->next; + } + tail->u.common = st->n.common; + tail->where = cur_loc; + + next_item: + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + while (*list) + list = &(*list)->next; + + *list = head; + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in OpenMP variable list at %C"); + +cleanup: + gfc_free_omp_namelist (head); + gfc_current_locus = old_loc; + return MATCH_ERROR; +} + +/* Match depend(sink : ...) construct a namelist from it. */ + +static match +gfc_match_omp_depend_sink (gfc_omp_namelist **list) +{ + gfc_omp_namelist *head, *tail, *p; + locus old_loc, cur_loc; + gfc_symbol *sym; + + head = tail = NULL; + + old_loc = gfc_current_locus; + + for (;;) + { + cur_loc = gfc_current_locus; + switch (gfc_match_symbol (&sym, 1)) + { + case MATCH_YES: + gfc_set_sym_referenced (sym); + p = gfc_get_omp_namelist (); + if (head == NULL) + { + head = tail = p; + head->u.depend_op = OMP_DEPEND_SINK_FIRST; + } + else + { + tail->next = p; + tail = tail->next; + tail->u.depend_op = OMP_DEPEND_SINK; + } + tail->sym = sym; + tail->expr = NULL; + tail->where = cur_loc; + if (gfc_match_char ('+') == MATCH_YES) + { + if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES) + goto syntax; + } + else if (gfc_match_char ('-') == MATCH_YES) + { + if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES) + goto syntax; + tail->expr = gfc_uminus (tail->expr); + } + break; + case MATCH_NO: + goto syntax; + case MATCH_ERROR: + goto cleanup; + } + + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + while (*list) + list = &(*list)->next; + + *list = head; + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C"); + +cleanup: + gfc_free_omp_namelist (head); + gfc_current_locus = old_loc; + return MATCH_ERROR; +} + static match match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk) @@ -563,67 +734,183 @@ cleanup: return MATCH_ERROR; } -#define OMP_CLAUSE_PRIVATE ((uint64_t) 1 << 0) -#define OMP_CLAUSE_FIRSTPRIVATE ((uint64_t) 1 << 1) -#define OMP_CLAUSE_LASTPRIVATE ((uint64_t) 1 << 2) -#define OMP_CLAUSE_COPYPRIVATE ((uint64_t) 1 << 3) -#define OMP_CLAUSE_SHARED ((uint64_t) 1 << 4) -#define OMP_CLAUSE_COPYIN ((uint64_t) 1 << 5) -#define OMP_CLAUSE_REDUCTION ((uint64_t) 1 << 6) -#define OMP_CLAUSE_IF ((uint64_t) 1 << 7) -#define OMP_CLAUSE_NUM_THREADS ((uint64_t) 1 << 8) -#define OMP_CLAUSE_SCHEDULE ((uint64_t) 1 << 9) -#define OMP_CLAUSE_DEFAULT ((uint64_t) 1 << 10) -#define OMP_CLAUSE_ORDERED ((uint64_t) 1 << 11) -#define OMP_CLAUSE_COLLAPSE ((uint64_t) 1 << 12) -#define OMP_CLAUSE_UNTIED ((uint64_t) 1 << 13) -#define OMP_CLAUSE_FINAL ((uint64_t) 1 << 14) -#define OMP_CLAUSE_MERGEABLE ((uint64_t) 1 << 15) -#define OMP_CLAUSE_ALIGNED ((uint64_t) 1 << 16) -#define OMP_CLAUSE_DEPEND ((uint64_t) 1 << 17) -#define OMP_CLAUSE_INBRANCH ((uint64_t) 1 << 18) -#define OMP_CLAUSE_LINEAR ((uint64_t) 1 << 19) -#define OMP_CLAUSE_NOTINBRANCH ((uint64_t) 1 << 20) -#define OMP_CLAUSE_PROC_BIND ((uint64_t) 1 << 21) -#define OMP_CLAUSE_SAFELEN ((uint64_t) 1 << 22) -#define OMP_CLAUSE_SIMDLEN ((uint64_t) 1 << 23) -#define OMP_CLAUSE_UNIFORM ((uint64_t) 1 << 24) -#define OMP_CLAUSE_DEVICE ((uint64_t) 1 << 25) -#define OMP_CLAUSE_MAP ((uint64_t) 1 << 26) -#define OMP_CLAUSE_TO ((uint64_t) 1 << 27) -#define OMP_CLAUSE_FROM ((uint64_t) 1 << 28) -#define OMP_CLAUSE_NUM_TEAMS ((uint64_t) 1 << 29) -#define OMP_CLAUSE_THREAD_LIMIT ((uint64_t) 1 << 30) -#define OMP_CLAUSE_DIST_SCHEDULE ((uint64_t) 1 << 31) - -/* OpenACC 2.0 clauses. */ -#define OMP_CLAUSE_ASYNC ((uint64_t) 1 << 32) -#define OMP_CLAUSE_NUM_GANGS ((uint64_t) 1 << 33) -#define OMP_CLAUSE_NUM_WORKERS ((uint64_t) 1 << 34) -#define OMP_CLAUSE_VECTOR_LENGTH ((uint64_t) 1 << 35) -#define OMP_CLAUSE_COPY ((uint64_t) 1 << 36) -#define OMP_CLAUSE_COPYOUT ((uint64_t) 1 << 37) -#define OMP_CLAUSE_CREATE ((uint64_t) 1 << 38) -#define OMP_CLAUSE_PRESENT ((uint64_t) 1 << 39) -#define OMP_CLAUSE_PRESENT_OR_COPY ((uint64_t) 1 << 40) -#define OMP_CLAUSE_PRESENT_OR_COPYIN ((uint64_t) 1 << 41) -#define OMP_CLAUSE_PRESENT_OR_COPYOUT ((uint64_t) 1 << 42) -#define OMP_CLAUSE_PRESENT_OR_CREATE ((uint64_t) 1 << 43) -#define OMP_CLAUSE_DEVICEPTR ((uint64_t) 1 << 44) -#define OMP_CLAUSE_GANG ((uint64_t) 1 << 45) -#define OMP_CLAUSE_WORKER ((uint64_t) 1 << 46) -#define OMP_CLAUSE_VECTOR ((uint64_t) 1 << 47) -#define OMP_CLAUSE_SEQ ((uint64_t) 1 << 48) -#define OMP_CLAUSE_INDEPENDENT ((uint64_t) 1 << 49) -#define OMP_CLAUSE_USE_DEVICE ((uint64_t) 1 << 50) -#define OMP_CLAUSE_DEVICE_RESIDENT ((uint64_t) 1 << 51) -#define OMP_CLAUSE_HOST_SELF ((uint64_t) 1 << 52) -#define OMP_CLAUSE_OACC_DEVICE ((uint64_t) 1 << 53) -#define OMP_CLAUSE_WAIT ((uint64_t) 1 << 54) -#define OMP_CLAUSE_DELETE ((uint64_t) 1 << 55) -#define OMP_CLAUSE_AUTO ((uint64_t) 1 << 56) -#define OMP_CLAUSE_TILE ((uint64_t) 1 << 57) -#define OMP_CLAUSE_LINK ((uint64_t) 1 << 58) +/* OpenMP 4.5 clauses. */ +enum omp_mask1 +{ + OMP_CLAUSE_PRIVATE, + OMP_CLAUSE_FIRSTPRIVATE, + OMP_CLAUSE_LASTPRIVATE, + OMP_CLAUSE_COPYPRIVATE, + OMP_CLAUSE_SHARED, + OMP_CLAUSE_COPYIN, + OMP_CLAUSE_REDUCTION, + OMP_CLAUSE_IF, + OMP_CLAUSE_NUM_THREADS, + OMP_CLAUSE_SCHEDULE, + OMP_CLAUSE_DEFAULT, + OMP_CLAUSE_ORDERED, + OMP_CLAUSE_COLLAPSE, + OMP_CLAUSE_UNTIED, + OMP_CLAUSE_FINAL, + OMP_CLAUSE_MERGEABLE, + 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, + OMP_CLAUSE_DEVICE, + OMP_CLAUSE_MAP, + OMP_CLAUSE_TO, + OMP_CLAUSE_FROM, + OMP_CLAUSE_NUM_TEAMS, + OMP_CLAUSE_THREAD_LIMIT, + OMP_CLAUSE_DIST_SCHEDULE, + OMP_CLAUSE_DEFAULTMAP, + OMP_CLAUSE_GRAINSIZE, + OMP_CLAUSE_HINT, + OMP_CLAUSE_IS_DEVICE_PTR, + OMP_CLAUSE_LINK, + OMP_CLAUSE_NOGROUP, + OMP_CLAUSE_NUM_TASKS, + OMP_CLAUSE_PRIORITY, + OMP_CLAUSE_SIMD, + OMP_CLAUSE_THREADS, + OMP_CLAUSE_USE_DEVICE_PTR, + OMP_CLAUSE_NOWAIT, + /* This must come last. */ + OMP_MASK1_LAST +}; + +/* OpenACC 2.0 specific clauses. */ +enum omp_mask2 +{ + OMP_CLAUSE_ASYNC, + OMP_CLAUSE_NUM_GANGS, + OMP_CLAUSE_NUM_WORKERS, + OMP_CLAUSE_VECTOR_LENGTH, + OMP_CLAUSE_COPY, + OMP_CLAUSE_COPYOUT, + OMP_CLAUSE_CREATE, + OMP_CLAUSE_PRESENT, + OMP_CLAUSE_PRESENT_OR_COPY, + OMP_CLAUSE_PRESENT_OR_COPYIN, + OMP_CLAUSE_PRESENT_OR_COPYOUT, + OMP_CLAUSE_PRESENT_OR_CREATE, + OMP_CLAUSE_DEVICEPTR, + OMP_CLAUSE_GANG, + OMP_CLAUSE_WORKER, + OMP_CLAUSE_VECTOR, + OMP_CLAUSE_SEQ, + OMP_CLAUSE_INDEPENDENT, + OMP_CLAUSE_USE_DEVICE, + OMP_CLAUSE_DEVICE_RESIDENT, + OMP_CLAUSE_HOST_SELF, + OMP_CLAUSE_WAIT, + OMP_CLAUSE_DELETE, + OMP_CLAUSE_AUTO, + OMP_CLAUSE_TILE, + /* This must come last. */ + OMP_MASK2_LAST +}; + +struct omp_inv_mask; + +/* Customized bitset for up to 128-bits. + The two enums above provide bit numbers to use, and which of the + two enums it is determines which of the two mask fields is used. + Supported operations are defining a mask, like: + #define XXX_CLAUSES \ + (omp_mask (OMP_CLAUSE_XXX) | OMP_CLAUSE_YYY | OMP_CLAUSE_ZZZ) + oring such bitsets together or removing selected bits: + (XXX_CLAUSES | YYY_CLAUSES) & ~(omp_mask (OMP_CLAUSE_VVV)) + and testing individual bits: + if (mask & OMP_CLAUSE_UUU) */ + +struct omp_mask { + const uint64_t mask1; + const uint64_t mask2; + inline omp_mask (); + inline omp_mask (omp_mask1); + inline omp_mask (omp_mask2); + inline omp_mask (uint64_t, uint64_t); + inline omp_mask operator| (omp_mask1) const; + inline omp_mask operator| (omp_mask2) const; + inline omp_mask operator| (omp_mask) const; + inline omp_mask operator& (const omp_inv_mask &) const; + inline bool operator& (omp_mask1) const; + inline bool operator& (omp_mask2) const; + inline omp_inv_mask operator~ () const; +}; + +struct omp_inv_mask : public omp_mask { + inline omp_inv_mask (const omp_mask &); +}; + +omp_mask::omp_mask () : mask1 (0), mask2 (0) +{ +} + +omp_mask::omp_mask (omp_mask1 m) : mask1 (((uint64_t) 1) << m), mask2 (0) +{ +} + +omp_mask::omp_mask (omp_mask2 m) : mask1 (0), mask2 (((uint64_t) 1) << m) +{ +} + +omp_mask::omp_mask (uint64_t m1, uint64_t m2) : mask1 (m1), mask2 (m2) +{ +} + +omp_mask +omp_mask::operator| (omp_mask1 m) const +{ + return omp_mask (mask1 | (((uint64_t) 1) << m), mask2); +} + +omp_mask +omp_mask::operator| (omp_mask2 m) const +{ + return omp_mask (mask1, mask2 | (((uint64_t) 1) << m)); +} + +omp_mask +omp_mask::operator| (omp_mask m) const +{ + return omp_mask (mask1 | m.mask1, mask2 | m.mask2); +} + +omp_mask +omp_mask::operator& (const omp_inv_mask &m) const +{ + return omp_mask (mask1 & ~m.mask1, mask2 & ~m.mask2); +} + +bool +omp_mask::operator& (omp_mask1 m) const +{ + return (mask1 & (((uint64_t) 1) << m)) != 0; +} + +bool +omp_mask::operator& (omp_mask2 m) const +{ + return (mask2 & (((uint64_t) 1) << m)) != 0; +} + +omp_inv_mask +omp_mask::operator~ () const +{ + return omp_inv_mask (*this); +} + +omp_inv_mask::omp_inv_mask (const omp_mask &m) : omp_mask (m) +{ +} /* Helper function for OpenACC and OpenMP clauses involving memory mapping. */ @@ -648,13 +935,14 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op) clauses that are allowed for a particular directive. */ static match -gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, +gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, bool first = true, bool needs_space = true, bool openacc = false) { gfc_omp_clauses *c = gfc_get_omp_clauses (); locus old_loc; + gcc_checking_assert (OMP_MASK1_LAST <= 64 && OMP_MASK2_LAST <= 64); *cp = NULL; while (1) { @@ -790,11 +1078,6 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, continue; break; case 'd': - if ((mask & OMP_CLAUSE_DELETE) - && gfc_match ("delete ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_DELETE)) - continue; if ((mask & OMP_CLAUSE_DEFAULT) && c->default_sharing == OMP_DEFAULT_UNKNOWN) { @@ -811,6 +1094,18 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, if (c->default_sharing != OMP_DEFAULT_UNKNOWN) continue; } + if ((mask & OMP_CLAUSE_DEFAULTMAP) + && !c->defaultmap + && gfc_match ("defaultmap ( tofrom : scalar )") == MATCH_YES) + { + c->defaultmap = true; + continue; + } + if ((mask & OMP_CLAUSE_DELETE) + && gfc_match ("delete ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_DELETE)) + continue; if ((mask & OMP_CLAUSE_DEPEND) && gfc_match ("depend ( ") == MATCH_YES) { @@ -822,6 +1117,19 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, depend_op = OMP_DEPEND_IN; else if (gfc_match ("out") == MATCH_YES) depend_op = OMP_DEPEND_OUT; + else if (!c->depend_source + && gfc_match ("source )") == MATCH_YES) + { + c->depend_source = true; + continue; + } + else if (gfc_match ("sink : ") == MATCH_YES) + { + if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND]) + == MATCH_YES) + continue; + m = MATCH_NO; + } else m = MATCH_NO; head = NULL; @@ -840,10 +1148,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, gfc_current_locus = old_loc; } if ((mask & OMP_CLAUSE_DEVICE) + && !openacc && c->device == NULL && gfc_match ("device ( %e )", &c->device) == MATCH_YES) continue; - if ((mask & OMP_CLAUSE_OACC_DEVICE) + if ((mask & OMP_CLAUSE_DEVICE) + && openacc && gfc_match ("device ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], OMP_MAP_FORCE_TO)) @@ -917,8 +1227,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_GRAINSIZE) + && c->grainsize == NULL + && gfc_match ("grainsize ( %e )", &c->grainsize) == MATCH_YES) + continue; break; case 'h': + if ((mask & OMP_CLAUSE_HINT) + && c->hint == NULL + && gfc_match ("hint ( %e )", &c->hint) == MATCH_YES) + continue; if ((mask & OMP_CLAUSE_HOST_SELF) && gfc_match ("host ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -928,8 +1246,32 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, case 'i': if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL - && gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES) - continue; + && gfc_match ("if ( ") == MATCH_YES) + { + if (gfc_match ("%e )", &c->if_expr) == MATCH_YES) + continue; + if (!openacc) + { + /* This should match the enum gfc_omp_if_kind order. */ + static const char *ifs[OMP_IF_LAST] = { + " parallel : %e )", + " task : %e )", + " taskloop : %e )", + " target : %e )", + " target data : %e )", + " target update : %e )", + " target enter data : %e )", + " target exit data : %e )" }; + int i; + for (i = 0; i < OMP_IF_LAST; i++) + if (c->if_exprs[i] == NULL + && gfc_match (ifs[i], &c->if_exprs[i]) == MATCH_YES) + break; + if (i < OMP_IF_LAST) + continue; + } + gfc_current_locus = old_loc; + } if ((mask & OMP_CLAUSE_INBRANCH) && !c->inbranch && !c->notinbranch @@ -946,6 +1288,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_IS_DEVICE_PTR) + && gfc_match_omp_variable_list + ("is_device_ptr (", + &c->lists[OMP_LIST_IS_DEVICE_PTR], false) == MATCH_YES) + continue; break; case 'l': if ((mask & OMP_CLAUSE_LASTPRIVATE) @@ -956,13 +1303,50 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, end_colon = false; head = NULL; if ((mask & OMP_CLAUSE_LINEAR) - && gfc_match_omp_variable_list ("linear (", - &c->lists[OMP_LIST_LINEAR], - false, &end_colon, - &head) == MATCH_YES) + && gfc_match ("linear (") == MATCH_YES) { + gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT; gfc_expr *step = NULL; + if (gfc_match_omp_variable_list (" ref (", + &c->lists[OMP_LIST_LINEAR], + false, NULL, &head) + == MATCH_YES) + linear_op = OMP_LINEAR_REF; + else if (gfc_match_omp_variable_list (" val (", + &c->lists[OMP_LIST_LINEAR], + false, NULL, &head) + == MATCH_YES) + linear_op = OMP_LINEAR_VAL; + else if (gfc_match_omp_variable_list (" uval (", + &c->lists[OMP_LIST_LINEAR], + false, NULL, &head) + == MATCH_YES) + linear_op = OMP_LINEAR_UVAL; + else if (gfc_match_omp_variable_list ("", + &c->lists[OMP_LIST_LINEAR], + false, &end_colon, &head) + == MATCH_YES) + linear_op = OMP_LINEAR_DEFAULT; + else + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + if (linear_op != OMP_LINEAR_DEFAULT) + { + if (gfc_match (" :") == MATCH_YES) + end_colon = true; + else if (gfc_match (" )") != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + } if (end_colon && gfc_match (" %e )", &step) != MATCH_YES) { gfc_free_omp_namelist (*head); @@ -978,27 +1362,50 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, mpz_set_si (step->value.integer, 1); } (*head)->expr = step; + if (linear_op != OMP_LINEAR_DEFAULT) + for (gfc_omp_namelist *n = *head; n; n = n->next) + n->u.linear_op = linear_op; continue; } if ((mask & OMP_CLAUSE_LINK) + && openacc && (gfc_match_oacc_clause_link ("link (", &c->lists[OMP_LIST_LINK]) == MATCH_YES)) continue; + else if ((mask & OMP_CLAUSE_LINK) + && !openacc + && (gfc_match_omp_to_link ("link (", + &c->lists[OMP_LIST_LINK]) + == MATCH_YES)) + continue; break; case 'm': if ((mask & OMP_CLAUSE_MAP) && gfc_match ("map ( ") == MATCH_YES) { + locus old_loc2 = gfc_current_locus; + bool always = false; gfc_omp_map_op map_op = OMP_MAP_TOFROM; + if (gfc_match ("always , ") == MATCH_YES) + always = true; if (gfc_match ("alloc : ") == MATCH_YES) map_op = OMP_MAP_ALLOC; else if (gfc_match ("tofrom : ") == MATCH_YES) - map_op = OMP_MAP_TOFROM; + map_op = always ? OMP_MAP_ALWAYS_TOFROM : OMP_MAP_TOFROM; else if (gfc_match ("to : ") == MATCH_YES) - map_op = OMP_MAP_TO; + map_op = always ? OMP_MAP_ALWAYS_TO : OMP_MAP_TO; else if (gfc_match ("from : ") == MATCH_YES) - map_op = OMP_MAP_FROM; + map_op = always ? OMP_MAP_ALWAYS_FROM : OMP_MAP_FROM; + else if (gfc_match ("release : ") == MATCH_YES) + map_op = OMP_MAP_RELEASE; + else if (gfc_match ("delete : ") == MATCH_YES) + map_op = OMP_MAP_DELETE; + else if (always) + { + gfc_current_locus = old_loc2; + always = false; + } head = NULL; if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], false, NULL, &head, @@ -1020,6 +1427,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, } break; case 'n': + if ((mask & OMP_CLAUSE_NOGROUP) + && !c->nogroup + && gfc_match ("nogroup") == MATCH_YES) + { + c->nogroup = needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_NOTINBRANCH) && !c->notinbranch && !c->inbranch @@ -1028,11 +1442,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, c->notinbranch = needs_space = true; continue; } + if ((mask & OMP_CLAUSE_NOWAIT) + && !c->nowait + && gfc_match ("nowait") == MATCH_YES) + { + c->nowait = needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES) continue; + if ((mask & OMP_CLAUSE_NUM_TASKS) + && c->num_tasks == NULL + && gfc_match ("num_tasks ( %e )", &c->num_tasks) == MATCH_YES) + continue; if ((mask & OMP_CLAUSE_NUM_TEAMS) && c->num_teams == NULL && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES) @@ -1053,7 +1478,31 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, && !c->ordered && gfc_match ("ordered") == MATCH_YES) { - c->ordered = needs_space = true; + gfc_expr *cexpr = NULL; + match m = gfc_match (" ( %e )", &cexpr); + + c->ordered = true; + if (m == MATCH_YES) + { + int ordered = 0; + const char *p = gfc_extract_int (cexpr, &ordered); + if (p) + { + gfc_error_now (p); + ordered = 0; + } + else if (ordered <= 0) + { + gfc_error_now ("ORDERED clause argument not" + " constant positive integer at %C"); + ordered = 0; + } + c->orderedc = ordered; + gfc_free_expr (cexpr); + continue; + } + + needs_space = true; continue; } break; @@ -1103,6 +1552,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], OMP_MAP_ALLOC)) continue; + if ((mask & OMP_CLAUSE_PRIORITY) + && c->priority == NULL + && gfc_match ("priority ( %e )", &c->priority) == MATCH_YES) + continue; if ((mask & OMP_CLAUSE_PRIVATE) && gfc_match_omp_variable_list ("private (", &c->lists[OMP_LIST_PRIVATE], @@ -1252,6 +1705,45 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, && c->sched_kind == OMP_SCHED_NONE && gfc_match ("schedule ( ") == MATCH_YES) { + int nmodifiers = 0; + locus old_loc2 = gfc_current_locus; + do + { + if (!c->sched_simd + && gfc_match ("simd") == MATCH_YES) + { + c->sched_simd = true; + nmodifiers++; + } + else if (!c->sched_monotonic + && !c->sched_nonmonotonic + && gfc_match ("monotonic") == MATCH_YES) + { + c->sched_monotonic = true; + nmodifiers++; + } + else if (!c->sched_monotonic + && !c->sched_nonmonotonic + && gfc_match ("nonmonotonic") == MATCH_YES) + { + c->sched_nonmonotonic = true; + nmodifiers++; + } + else + { + if (nmodifiers) + gfc_current_locus = old_loc2; + break; + } + if (nmodifiers == 0 + && gfc_match (" , ") == MATCH_YES) + continue; + else if (gfc_match (" : ") == MATCH_YES) + break; + gfc_current_locus = old_loc2; + break; + } + while (1); if (gfc_match ("static") == MATCH_YES) c->sched_kind = OMP_SCHED_STATIC; else if (gfc_match ("dynamic") == MATCH_YES) @@ -1300,6 +1792,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, && c->simdlen_expr == NULL && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) continue; + if ((mask & OMP_CLAUSE_SIMD) + && !c->simd + && gfc_match ("simd") == MATCH_YES) + { + c->simd = needs_space = true; + continue; + } break; case 't': if ((mask & OMP_CLAUSE_THREAD_LIMIT) @@ -1307,12 +1806,25 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, && gfc_match ("thread_limit ( %e )", &c->thread_limit) == MATCH_YES) continue; + if ((mask & OMP_CLAUSE_THREADS) + && !c->threads + && gfc_match ("threads") == MATCH_YES) + { + c->threads = needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_TILE) && !c->tile_list && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES) continue; - if ((mask & OMP_CLAUSE_TO) + if ((mask & OMP_CLAUSE_TO) && (mask & OMP_CLAUSE_LINK)) + { + if (gfc_match_omp_to_link ("to (", &c->lists[OMP_LIST_TO]) + == MATCH_YES) + continue; + } + else if ((mask & OMP_CLAUSE_TO) && gfc_match_omp_variable_list ("to (", &c->lists[OMP_LIST_TO], false, NULL, &head, true) == MATCH_YES) @@ -1336,6 +1848,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, &c->lists[OMP_LIST_USE_DEVICE], true) == MATCH_YES) continue; + if ((mask & OMP_CLAUSE_USE_DEVICE_PTR) + && gfc_match_omp_variable_list + ("use_device_ptr (", + &c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES) + continue; break; case 'v': /* VECTOR_LENGTH must be matched before VECTOR, because the latter @@ -1409,59 +1926,60 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, #define OACC_PARALLEL_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \ - | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ + | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ + | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) #define OACC_KERNELS_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \ - | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \ + | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ + | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) #define OACC_DATA_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \ - | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \ - | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \ + | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \ + | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ + | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ | OMP_CLAUSE_PRESENT_OR_CREATE) #define OACC_LOOP_CLAUSES \ - (OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \ - | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \ - | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \ + (omp_mask (OMP_CLAUSE_COLLAPSE) | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \ + | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \ + | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \ | OMP_CLAUSE_TILE) #define OACC_PARALLEL_LOOP_CLAUSES \ (OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES) #define OACC_KERNELS_LOOP_CLAUSES \ (OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES) -#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE +#define OACC_HOST_DATA_CLAUSES omp_mask (OMP_CLAUSE_USE_DEVICE) #define OACC_DECLARE_CLAUSES \ - (OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ + (omp_mask (OMP_CLAUSE_COPY) | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \ - | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ + | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ + | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_LINK) #define OACC_UPDATE_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \ - | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT) + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \ + | OMP_CLAUSE_DEVICE | OMP_CLAUSE_WAIT) #define OACC_ENTER_DATA_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYIN \ - | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT \ + | OMP_CLAUSE_COPYIN | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \ | OMP_CLAUSE_PRESENT_OR_CREATE) #define OACC_EXIT_DATA_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYOUT \ - | OMP_CLAUSE_DELETE) + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT \ + | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_DELETE) #define OACC_WAIT_CLAUSES \ - (OMP_CLAUSE_ASYNC) + omp_mask (OMP_CLAUSE_ASYNC) #define OACC_ROUTINE_CLAUSES \ - (OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ) + (omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR \ + | OMP_CLAUSE_SEQ) static match -match_acc (gfc_exec_op op, uint64_t mask) +match_acc (gfc_exec_op op, const omp_mask mask) { gfc_omp_clauses *c; if (gfc_match_omp_clauses (&c, mask, false, false, true) != MATCH_YES) @@ -1853,44 +2371,71 @@ cleanup: #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_PROC_BIND) + (omp_mask (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_PROC_BIND) #define OMP_DECLARE_SIMD_CLAUSES \ - (OMP_CLAUSE_SIMDLEN | OMP_CLAUSE_LINEAR | OMP_CLAUSE_UNIFORM \ - | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH | OMP_CLAUSE_NOTINBRANCH) + (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \ + | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \ + | OMP_CLAUSE_NOTINBRANCH) #define OMP_DO_CLAUSES \ - (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ - | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE) + | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ + | OMP_CLAUSE_LINEAR) #define OMP_SECTIONS_CLAUSES \ - (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ + (omp_mask (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) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \ + | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \ + | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_SIMDLEN) #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_DEPEND) + (omp_mask (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_DEPEND | OMP_CLAUSE_PRIORITY) +#define OMP_TASKLOOP_CLAUSES \ + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ + | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \ + | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \ + | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP) #define OMP_TARGET_CLAUSES \ - (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF) + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ + | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \ + | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \ + | OMP_CLAUSE_IS_DEVICE_PTR) #define OMP_TARGET_DATA_CLAUSES \ - (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF) + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ + | OMP_CLAUSE_USE_DEVICE_PTR) +#define OMP_TARGET_ENTER_DATA_CLAUSES \ + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ + | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT) +#define OMP_TARGET_EXIT_DATA_CLAUSES \ + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ + | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT) #define OMP_TARGET_UPDATE_CLAUSES \ - (OMP_CLAUSE_DEVICE | OMP_CLAUSE_IF | OMP_CLAUSE_TO | OMP_CLAUSE_FROM) + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_IF | OMP_CLAUSE_TO \ + | OMP_CLAUSE_FROM | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT) #define OMP_TEAMS_CLAUSES \ - (OMP_CLAUSE_NUM_TEAMS | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ - | OMP_CLAUSE_REDUCTION) + (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \ + | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) #define OMP_DISTRIBUTE_CLAUSES \ - (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_COLLAPSE \ - | OMP_CLAUSE_DIST_SCHEDULE) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE) +#define OMP_SINGLE_CLAUSES \ + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) +#define OMP_ORDERED_CLAUSES \ + (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) +#define OMP_DECLARE_TARGET_CLAUSES \ + (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK) static match -match_omp (gfc_exec_op op, unsigned int mask) +match_omp (gfc_exec_op op, const omp_mask mask) { gfc_omp_clauses *c; if (gfc_match_omp_clauses (&c, mask) != MATCH_YES) @@ -1905,6 +2450,32 @@ match gfc_match_omp_critical (void) { char n[GFC_MAX_SYMBOL_LEN+1]; + gfc_omp_clauses *c = NULL; + + if (gfc_match (" ( %n )", n) != MATCH_YES) + { + n[0] = '\0'; + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); + return MATCH_ERROR; + } + } + else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_HINT)) != MATCH_YES) + return MATCH_ERROR; + + new_st.op = EXEC_OMP_CRITICAL; + new_st.ext.omp_clauses = c; + if (n[0]) + c->critical_name = xstrdup (n); + return MATCH_YES; +} + + +match +gfc_match_omp_end_critical (void) +{ + char n[GFC_MAX_SYMBOL_LEN+1]; if (gfc_match (" ( %n )", n) != MATCH_YES) n[0] = '\0'; @@ -1913,7 +2484,8 @@ gfc_match_omp_critical (void) gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); return MATCH_ERROR; } - new_st.op = EXEC_OMP_CRITICAL; + + new_st.op = EXEC_OMP_END_CRITICAL; new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL; return MATCH_YES; } @@ -1930,8 +2502,10 @@ match gfc_match_omp_distribute_parallel_do (void) { return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO, - OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES - | OMP_DO_CLAUSES); + (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_ORDERED)) + & ~(omp_mask (OMP_CLAUSE_LINEAR))); } @@ -1941,7 +2515,7 @@ gfc_match_omp_distribute_parallel_do_simd (void) return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) - & ~OMP_CLAUSE_ORDERED); + & ~(omp_mask (OMP_CLAUSE_ORDERED))); } @@ -1963,8 +2537,7 @@ gfc_match_omp_do (void) match gfc_match_omp_do_simd (void) { - return match_omp (EXEC_OMP_DO_SIMD, ((OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) - & ~OMP_CLAUSE_ORDERED)); + return match_omp (EXEC_OMP_DO_SIMD, OMP_DO_CLAUSES | OMP_SIMD_CLAUSES); } @@ -1992,12 +2565,17 @@ gfc_match_omp_declare_simd (void) gfc_symbol *proc_name; gfc_omp_clauses *c; gfc_omp_declare_simd *ods; + bool needs_space = false; - if (gfc_match (" ( %s ) ", &proc_name) != MATCH_YES) - return MATCH_ERROR; + switch (gfc_match (" ( %s ) ", &proc_name)) + { + case MATCH_YES: break; + case MATCH_NO: proc_name = NULL; needs_space = true; break; + case MATCH_ERROR: return MATCH_ERROR; + } if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true, - false) != MATCH_YES) + needs_space) != MATCH_YES) return MATCH_ERROR; if (gfc_current_ns->is_block_data) @@ -2411,26 +2989,15 @@ match gfc_match_omp_declare_target (void) { locus old_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; - gfc_symbol *sym; match m; - gfc_symtree *st; + gfc_omp_clauses *c = NULL; + int list; + gfc_omp_namelist *n; + gfc_symbol *s; old_loc = gfc_current_locus; - m = gfc_match (" ("); - if (gfc_current_ns->proc_name - && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY - && m == MATCH_YES) - { - gfc_error ("Only the !$OMP DECLARE TARGET form without " - "list is allowed in interface block at %C"); - goto cleanup; - } - - if (m == MATCH_NO - && gfc_current_ns->proc_name && gfc_match_omp_eos () == MATCH_YES) { if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr, @@ -2440,58 +3007,111 @@ gfc_match_omp_declare_target (void) return MATCH_YES; } - if (m != MATCH_YES) - return m; + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY) + { + gfc_error ("Only the !$OMP DECLARE TARGET form without " + "clauses is allowed in interface block at %C"); + goto cleanup; + } - for (;;) + m = gfc_match (" ("); + if (m == MATCH_YES) { - m = gfc_match_symbol (&sym, 0); - switch (m) + c = gfc_get_omp_clauses (); + gfc_current_locus = old_loc; + m = gfc_match_omp_to_link (" (", &c->lists[OMP_LIST_TO]); + if (m != MATCH_YES) + goto syntax; + if (gfc_match_omp_eos () != MATCH_YES) { - case MATCH_YES: - if (sym->attr.in_common) - gfc_error_now ("OMP DECLARE TARGET on a variable at %C is an " - "element of a COMMON block"); - else if (!gfc_add_omp_declare_target (&sym->attr, sym->name, - &sym->declared_at)) - goto cleanup; - goto next_item; - case MATCH_NO: - break; - case MATCH_ERROR: + gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C"); goto cleanup; } + } + else if (gfc_match_omp_clauses (&c, OMP_DECLARE_TARGET_CLAUSES) != MATCH_YES) + return MATCH_ERROR; - m = gfc_match (" / %n /", n); - if (m == MATCH_ERROR) - goto cleanup; - if (m == MATCH_NO || n[0] == '\0') - goto syntax; + gfc_buffer_error (false); - st = gfc_find_symtree (gfc_current_ns->common_root, n); - if (st == NULL) + for (list = OMP_LIST_TO; list != OMP_LIST_NUM; + list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM)) + for (n = c->lists[list]; n; n = n->next) + if (n->sym) + n->sym->mark = 0; + else if (n->u.common->head) + n->u.common->head->mark = 0; + + for (list = OMP_LIST_TO; list != OMP_LIST_NUM; + list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM)) + for (n = c->lists[list]; n; n = n->next) + if (n->sym) { - gfc_error ("COMMON block /%s/ not found at %C", n); - goto cleanup; + if (n->sym->attr.in_common) + gfc_error_now ("OMP DECLARE TARGET variable at %L is an " + "element of a COMMON block", &n->where); + else if (n->sym->attr.omp_declare_target + && n->sym->attr.omp_declare_target_link + && list != OMP_LIST_LINK) + gfc_error_now ("OMP DECLARE TARGET variable at %L previously " + "mentioned in LINK clause and later in TO clause", + &n->where); + else if (n->sym->attr.omp_declare_target + && !n->sym->attr.omp_declare_target_link + && list == OMP_LIST_LINK) + gfc_error_now ("OMP DECLARE TARGET variable at %L previously " + "mentioned in TO clause and later in LINK clause", + &n->where); + else if (n->sym->mark) + gfc_error_now ("Variable at %L mentioned multiple times in " + "clauses of the same OMP DECLARE TARGET directive", + &n->where); + else if (gfc_add_omp_declare_target (&n->sym->attr, n->sym->name, + &n->sym->declared_at)) + { + if (list == OMP_LIST_LINK) + gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name, + &n->sym->declared_at); + } + n->sym->mark = 1; + } + else if (n->u.common->omp_declare_target + && n->u.common->omp_declare_target_link + && list != OMP_LIST_LINK) + gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously " + "mentioned in LINK clause and later in TO clause", + &n->where); + else if (n->u.common->omp_declare_target + && !n->u.common->omp_declare_target_link + && list == OMP_LIST_LINK) + gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously " + "mentioned in TO clause and later in LINK clause", + &n->where); + else if (n->u.common->head && n->u.common->head->mark) + gfc_error_now ("COMMON at %L mentioned multiple times in " + "clauses of the same OMP DECLARE TARGET directive", + &n->where); + else + { + n->u.common->omp_declare_target = 1; + n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK); + for (s = n->u.common->head; s; s = s->common_next) + { + s->mark = 1; + if (gfc_add_omp_declare_target (&s->attr, s->name, + &s->declared_at)) + { + if (list == OMP_LIST_LINK) + gfc_add_omp_declare_target_link (&s->attr, s->name, + &s->declared_at); + } + } } - st->n.common->omp_declare_target = 1; - for (sym = st->n.common->head; sym; sym = sym->common_next) - if (!gfc_add_omp_declare_target (&sym->attr, sym->name, - &sym->declared_at)) - goto cleanup; - next_item: - if (gfc_match_char (')') == MATCH_YES) - break; - if (gfc_match_char (',') != MATCH_YES) - goto syntax; - } + gfc_buffer_error (true); - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C"); - goto cleanup; - } + if (c) + gfc_free_omp_clauses (c); return MATCH_YES; syntax: @@ -2499,6 +3119,8 @@ syntax: cleanup: gfc_current_locus = old_loc; + if (c) + gfc_free_omp_clauses (c); return MATCH_ERROR; } @@ -2596,8 +3218,7 @@ match gfc_match_omp_parallel_do_simd (void) { return match_omp (EXEC_OMP_PARALLEL_DO_SIMD, - (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) - & ~OMP_CLAUSE_ORDERED); + OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES); } @@ -2633,57 +3254,70 @@ gfc_match_omp_simd (void) match gfc_match_omp_single (void) { - return match_omp (EXEC_OMP_SINGLE, - OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE); + return match_omp (EXEC_OMP_SINGLE, OMP_SINGLE_CLAUSES); } match -gfc_match_omp_task (void) +gfc_match_omp_target (void) { - return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES); + return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES); } match -gfc_match_omp_taskwait (void) +gfc_match_omp_target_data (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after TASKWAIT clause at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_TASKWAIT; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES); } match -gfc_match_omp_taskyield (void) +gfc_match_omp_target_enter_data (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after TASKYIELD clause at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_TASKYIELD; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_TARGET_ENTER_DATA, OMP_TARGET_ENTER_DATA_CLAUSES); } match -gfc_match_omp_target (void) +gfc_match_omp_target_exit_data (void) { - return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES); + return match_omp (EXEC_OMP_TARGET_EXIT_DATA, OMP_TARGET_EXIT_DATA_CLAUSES); } match -gfc_match_omp_target_data (void) +gfc_match_omp_target_parallel (void) { - return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES); + return match_omp (EXEC_OMP_TARGET_PARALLEL, + (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_COPYIN))); +} + + +match +gfc_match_omp_target_parallel_do (void) +{ + return match_omp (EXEC_OMP_TARGET_PARALLEL_DO, + (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES) & ~(omp_mask (OMP_CLAUSE_COPYIN))); +} + + +match +gfc_match_omp_target_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_TARGET_PARALLEL_DO_SIMD, + (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES + | OMP_SIMD_CLAUSES) & ~(omp_mask (OMP_CLAUSE_COPYIN))); +} + + +match +gfc_match_omp_target_simd (void) +{ + return match_omp (EXEC_OMP_TARGET_SIMD, + OMP_TARGET_CLAUSES | OMP_SIMD_CLAUSES); } @@ -2708,9 +3342,11 @@ match gfc_match_omp_target_teams_distribute_parallel_do (void) { return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, - OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES - | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES - | OMP_DO_CLAUSES); + (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_ORDERED)) + & ~(omp_mask (OMP_CLAUSE_LINEAR))); } @@ -2721,7 +3357,7 @@ gfc_match_omp_target_teams_distribute_parallel_do_simd (void) (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) - & ~OMP_CLAUSE_ORDERED); + & ~(omp_mask (OMP_CLAUSE_ORDERED))); } @@ -2742,6 +3378,57 @@ gfc_match_omp_target_update (void) match +gfc_match_omp_task (void) +{ + return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES); +} + + +match +gfc_match_omp_taskloop (void) +{ + return match_omp (EXEC_OMP_TASKLOOP, OMP_TASKLOOP_CLAUSES); +} + + +match +gfc_match_omp_taskloop_simd (void) +{ + return match_omp (EXEC_OMP_TASKLOOP_SIMD, + (OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_REDUCTION))); +} + + +match +gfc_match_omp_taskwait (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after TASKWAIT clause at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKWAIT; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; +} + + +match +gfc_match_omp_taskyield (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after TASKYIELD clause at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKYIELD; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; +} + + +match gfc_match_omp_teams (void) { return match_omp (EXEC_OMP_TEAMS, OMP_TEAMS_CLAUSES); @@ -2760,8 +3447,10 @@ match gfc_match_omp_teams_distribute_parallel_do (void) { return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, - OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES - | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES); + (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES + | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_ORDERED)) + & ~(omp_mask (OMP_CLAUSE_LINEAR))); } @@ -2771,7 +3460,7 @@ gfc_match_omp_teams_distribute_parallel_do_simd (void) return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES - | OMP_SIMD_CLAUSES) & ~OMP_CLAUSE_ORDERED); + | OMP_SIMD_CLAUSES) & ~(omp_mask (OMP_CLAUSE_ORDERED))); } @@ -2815,14 +3504,14 @@ gfc_match_omp_master (void) match gfc_match_omp_ordered (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after $OMP ORDERED statement at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_ORDERED; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_ORDERED, OMP_ORDERED_CLAUSES); +} + + +match +gfc_match_omp_ordered_depend (void) +{ + return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND)); } @@ -2935,7 +3624,7 @@ gfc_match_omp_cancel (void) 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) + if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_IF), false) != MATCH_YES) return MATCH_ERROR; c->cancel = kind; new_st.op = EXEC_OMP_CANCEL; @@ -2992,7 +3681,8 @@ gfc_match_omp_end_single (void) new_st.ext.omp_bool = true; return MATCH_YES; } - if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES) + if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_COPYPRIVATE)) + != MATCH_YES) return MATCH_ERROR; new_st.op = EXEC_OMP_END_SINGLE; new_st.ext.omp_clauses = c; @@ -3009,23 +3699,35 @@ oacc_is_loop (gfc_code *code) } static void -resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause) +resolve_scalar_int_expr (gfc_expr *expr, const char *clause) { if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) + || expr->ts.type != BT_INTEGER + || expr->rank != 0) gfc_error ("%s clause at %L requires a scalar INTEGER expression", - clause, &expr->where); + clause, &expr->where); } - static void -resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause) +resolve_positive_int_expr (gfc_expr *expr, const char *clause) { - resolve_oacc_scalar_int_expr (expr, clause); - if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER - && mpz_sgn(expr->value.integer) <= 0) + resolve_scalar_int_expr (expr, clause); + if (expr->expr_type == EXPR_CONSTANT + && expr->ts.type == BT_INTEGER + && mpz_sgn (expr->value.integer) <= 0) gfc_warning (0, "INTEGER expression of %s clause at %L must be positive", - clause, &expr->where); + clause, &expr->where); +} + +static void +resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause) +{ + resolve_scalar_int_expr (expr, clause); + if (expr->expr_type == EXPR_CONSTANT + && expr->ts.type == BT_INTEGER + && mpz_sgn (expr->value.integer) < 0) + gfc_warning (0, "INTEGER expression of %s clause at %L must be " + "non-negative", clause, &expr->where); } /* Emits error when symbol is pointer, cray pointer or cray pointee @@ -3229,15 +3931,22 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_omp_namelist *n; gfc_expr_list *el; int list; + int ifc; + bool if_without_mod = false; + gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT; static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", "TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", - "CACHE" }; + "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR" }; if (omp_clauses == NULL) return; + if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse) + gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L", + &code->loc); + if (omp_clauses->if_expr) { gfc_expr *expr = omp_clauses->if_expr; @@ -3245,7 +3954,101 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, || expr->ts.type != BT_LOGICAL || expr->rank != 0) gfc_error ("IF clause at %L requires a scalar LOGICAL expression", &expr->where); + if_without_mod = true; } + for (ifc = 0; ifc < OMP_IF_LAST; ifc++) + if (omp_clauses->if_exprs[ifc]) + { + gfc_expr *expr = omp_clauses->if_exprs[ifc]; + bool ok = true; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_LOGICAL || expr->rank != 0) + gfc_error ("IF clause at %L requires a scalar LOGICAL expression", + &expr->where); + else if (if_without_mod) + { + gfc_error ("IF clause without modifier at %L used together with" + "IF clauses with modifiers", + &omp_clauses->if_expr->where); + if_without_mod = false; + } + else + switch (code->op) + { + case EXEC_OMP_PARALLEL: + case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + ok = ifc == OMP_IF_PARALLEL; + break; + + case EXEC_OMP_TASK: + ok = ifc == OMP_IF_TASK; + break; + + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: + ok = ifc == OMP_IF_TASKLOOP; + break; + + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_SIMD: + ok = ifc == OMP_IF_TARGET; + break; + + case EXEC_OMP_TARGET_DATA: + ok = ifc == OMP_IF_TARGET_DATA; + break; + + case EXEC_OMP_TARGET_UPDATE: + ok = ifc == OMP_IF_TARGET_UPDATE; + break; + + case EXEC_OMP_TARGET_ENTER_DATA: + ok = ifc == OMP_IF_TARGET_ENTER_DATA; + break; + + case EXEC_OMP_TARGET_EXIT_DATA: + ok = ifc == OMP_IF_TARGET_EXIT_DATA; + break; + + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_PARALLEL; + break; + + default: + ok = false; + break; + } + if (!ok) + { + static const char *ifs[] = { + "PARALLEL", + "TASK", + "TASKLOOP", + "TARGET", + "TARGET DATA", + "TARGET UPDATE", + "TARGET ENTER DATA", + "TARGET EXIT DATA" + }; + gfc_error ("IF clause modifier %s at %L not appropriate for " + "the current OpenMP construct", ifs[ifc], &expr->where); + } + } + if (omp_clauses->final_expr) { gfc_expr *expr = omp_clauses->final_expr; @@ -3255,13 +4058,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, &expr->where); } if (omp_clauses->num_threads) - { - gfc_expr *expr = omp_clauses->num_threads; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("NUM_THREADS clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS"); if (omp_clauses->chunk_size) { gfc_expr *expr = omp_clauses->chunk_size; @@ -3499,6 +4296,36 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case OMP_LIST_CACHE: for (; n != NULL; n = n->next) { + if (list == OMP_LIST_DEPEND) + { + if (n->u.depend_op == OMP_DEPEND_SINK_FIRST + || n->u.depend_op == OMP_DEPEND_SINK) + { + if (code->op != EXEC_OMP_ORDERED) + gfc_error ("SINK dependence type only allowed " + "on ORDERED directive at %L", &n->where); + else if (omp_clauses->depend_source) + { + gfc_error ("DEPEND SINK used together with " + "DEPEND SOURCE on the same construct " + "at %L", &n->where); + omp_clauses->depend_source = false; + } + else if (n->expr) + { + if (!gfc_resolve_expr (n->expr) + || n->expr->ts.type != BT_INTEGER + || n->expr->rank != 0) + gfc_error ("SINK addend not a constant integer" + "at %L", &n->where); + } + continue; + } + else if (code->op == EXEC_OMP_ORDERED) + gfc_error ("Only SOURCE or SINK dependence types " + "are allowed on ORDERED directive at %L", + &n->where); + } if (n->expr) { if (!gfc_resolve_expr (n->expr) @@ -3555,6 +4382,62 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, else resolve_oacc_data_clauses (n->sym, n->where, name); } + if (list == OMP_LIST_MAP && !openacc) + switch (code->op) + { + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + switch (n->u.map_op) + { + case OMP_MAP_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_TOFROM: + case OMP_MAP_ALWAYS_TOFROM: + case OMP_MAP_ALLOC: + break; + default: + gfc_error ("TARGET%s with map-type other than TO, " + "FROM, TOFROM, or ALLOC on MAP clause " + "at %L", + code->op == EXEC_OMP_TARGET + ? "" : " DATA", &n->where); + break; + } + break; + case EXEC_OMP_TARGET_ENTER_DATA: + switch (n->u.map_op) + { + case OMP_MAP_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_ALLOC: + break; + default: + gfc_error ("TARGET ENTER DATA with map-type other " + "than TO, or ALLOC on MAP clause at %L", + &n->where); + break; + } + break; + case EXEC_OMP_TARGET_EXIT_DATA: + switch (n->u.map_op) + { + case OMP_MAP_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_RELEASE: + case OMP_MAP_DELETE: + break; + default: + gfc_error ("TARGET EXIT DATA with map-type other " + "than FROM, RELEASE, or DELETE on MAP " + "clause at %L", &n->where); + break; + } + break; + default: + break; + } } if (list != OMP_LIST_DEPEND) @@ -3569,6 +4452,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->name, name, &n->where); } break; + case OMP_LIST_IS_DEVICE_PTR: + case OMP_LIST_USE_DEVICE_PTR: + /* FIXME: Handle these. */ + break; default: for (; n != NULL; n = n->next) { @@ -3726,12 +4613,30 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } break; case OMP_LIST_LINEAR: - if (n->sym->ts.type != BT_INTEGER) + if (code + && n->u.linear_op != OMP_LINEAR_DEFAULT + && n->u.linear_op != linear_op) + { + gfc_error ("LINEAR clause modifier used on DO or SIMD" + " construct at %L", &n->where); + linear_op = n->u.linear_op; + } + else if (omp_clauses->orderedc) + gfc_error ("LINEAR clause specified together with" + "ORDERED clause with argument at %L", + &n->where); + else if (n->u.linear_op != OMP_LINEAR_REF + && n->sym->ts.type != BT_INTEGER) gfc_error ("LINEAR variable %qs must be INTEGER " "at %L", n->sym->name, &n->where); - else if (!code && !n->sym->attr.value) - gfc_error ("LINEAR dummy argument %qs must have VALUE " - "attribute at %L", n->sym->name, &n->where); + else if ((n->u.linear_op == OMP_LINEAR_REF + || n->u.linear_op == OMP_LINEAR_UVAL) + && n->sym->attr.value) + gfc_error ("LINEAR dummy argument %qs with VALUE " + "attribute with %s modifier at %L", + n->sym->name, + n->u.linear_op == OMP_LINEAR_REF + ? "REF" : "UVAL", &n->where); else if (n->expr) { gfc_expr *expr = n->expr; @@ -3742,9 +4647,25 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "a scalar integer linear-step expression", n->sym->name, &n->where); else if (!code && expr->expr_type != EXPR_CONSTANT) - gfc_error ("%qs in LINEAR clause at %L requires " - "a constant integer linear-step expression", - n->sym->name, &n->where); + { + if (expr->expr_type == EXPR_VARIABLE + && expr->symtree->n.sym->attr.dummy + && expr->symtree->n.sym->ns == ns) + { + gfc_omp_namelist *n2; + for (n2 = omp_clauses->lists[OMP_LIST_UNIFORM]; + n2; n2 = n2->next) + if (n2->sym == expr->symtree->n.sym) + break; + if (n2) + break; + } + gfc_error ("%qs in LINEAR clause at %L requires " + "a constant integer linear-step " + "expression or dummy argument " + "specified in UNIFORM clause", + n->sym->name, &n->where); + } } break; /* Workaround for PR middle-end/26316, nothing really needs @@ -3789,37 +4710,17 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } } 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); - } + resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN"); 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); - } + resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN"); if (omp_clauses->num_teams) - { - gfc_expr *expr = omp_clauses->num_teams; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("NUM_TEAMS clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS"); if (omp_clauses->device) - { - gfc_expr *expr = omp_clauses->device; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("DEVICE clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE"); + if (omp_clauses->hint) + resolve_scalar_int_expr (omp_clauses->hint, "HINT"); + if (omp_clauses->priority) + resolve_nonnegative_int_expr (omp_clauses->priority, "PRIORITY"); if (omp_clauses->dist_chunk_size) { gfc_expr *expr = omp_clauses->dist_chunk_size; @@ -3829,36 +4730,50 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "a scalar INTEGER expression", &expr->where); } if (omp_clauses->thread_limit) - { - gfc_expr *expr = omp_clauses->thread_limit; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("THREAD_LIMIT clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->thread_limit, "THREAD_LIMIT"); + if (omp_clauses->grainsize) + resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE"); + if (omp_clauses->num_tasks) + resolve_positive_int_expr (omp_clauses->num_tasks, "NUM_TASKS"); if (omp_clauses->async) if (omp_clauses->async_expr) - resolve_oacc_scalar_int_expr (omp_clauses->async_expr, "ASYNC"); + resolve_scalar_int_expr (omp_clauses->async_expr, "ASYNC"); if (omp_clauses->num_gangs_expr) - resolve_oacc_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); + resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); if (omp_clauses->num_workers_expr) - resolve_oacc_positive_int_expr (omp_clauses->num_workers_expr, - "NUM_WORKERS"); + resolve_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS"); if (omp_clauses->vector_length_expr) - resolve_oacc_positive_int_expr (omp_clauses->vector_length_expr, - "VECTOR_LENGTH"); + resolve_positive_int_expr (omp_clauses->vector_length_expr, + "VECTOR_LENGTH"); if (omp_clauses->gang_num_expr) - resolve_oacc_positive_int_expr (omp_clauses->gang_num_expr, "GANG"); + resolve_positive_int_expr (omp_clauses->gang_num_expr, "GANG"); if (omp_clauses->gang_static_expr) - resolve_oacc_positive_int_expr (omp_clauses->gang_static_expr, "GANG"); + resolve_positive_int_expr (omp_clauses->gang_static_expr, "GANG"); if (omp_clauses->worker_expr) - resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER"); + resolve_positive_int_expr (omp_clauses->worker_expr, "WORKER"); if (omp_clauses->vector_expr) - resolve_oacc_positive_int_expr (omp_clauses->vector_expr, "VECTOR"); + resolve_positive_int_expr (omp_clauses->vector_expr, "VECTOR"); if (omp_clauses->wait) if (omp_clauses->wait_list) for (el = omp_clauses->wait_list; el; el = el->next) - resolve_oacc_scalar_int_expr (el->expr, "WAIT"); + resolve_scalar_int_expr (el->expr, "WAIT"); + if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED) + gfc_error ("SOURCE dependence type only allowed " + "on ORDERED directive at %L", &code->loc); + if (!openacc && code && omp_clauses->lists[OMP_LIST_MAP] == NULL) + { + const char *p = NULL; + switch (code->op) + { + case EXEC_OMP_TARGET_DATA: p = "TARGET DATA"; break; + case EXEC_OMP_TARGET_ENTER_DATA: p = "TARGET ENTER DATA"; break; + case EXEC_OMP_TARGET_EXIT_DATA: p = "TARGET EXIT DATA"; break; + default: break; + } + if (p) + gfc_error ("%s must contain at least one MAP clause at %L", + p, &code->loc); + } } @@ -4361,7 +5276,10 @@ gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) gfc_code *c; omp_current_do_code = code->block->next; - omp_current_do_collapse = code->ext.omp_clauses->collapse; + if (code->ext.omp_clauses->orderedc) + omp_current_do_collapse = code->ext.omp_clauses->orderedc; + else + omp_current_do_collapse = code->ext.omp_clauses->collapse; for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++) { c = c->block; @@ -4415,6 +5333,8 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) { case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -4540,8 +5460,17 @@ resolve_omp_do (gfc_code *code) is_simd = true; break; case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_PARALLEL_DO: name = "!$OMP TARGET PARALLEL DO"; break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + name = "!$OMP TARGET PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_TARGET_SIMD: + name = "!$OMP TARGET SIMD"; + is_simd = true; + break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: - name = "!$OMP TARGET TEAMS_DISTRIBUTE"; + name = "!$OMP TARGET TEAMS DISTRIBUTE"; break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: name = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO"; @@ -4554,7 +5483,12 @@ resolve_omp_do (gfc_code *code) name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; is_simd = true; break; - case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS_DISTRIBUTE"; break; + case EXEC_OMP_TASKLOOP: name = "!$OMP TASKLOOP"; break; + case EXEC_OMP_TASKLOOP_SIMD: + name = "!$OMP TASKLOOP SIMD"; + is_simd = true; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS DISTRIBUTE"; break; case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: name = "!$OMP TEAMS DISTRIBUTE PARALLEL DO"; break; @@ -4573,9 +5507,14 @@ resolve_omp_do (gfc_code *code) resolve_omp_clauses (code, code->ext.omp_clauses, NULL); do_code = code->block->next; - collapse = code->ext.omp_clauses->collapse; - if (collapse <= 0) - collapse = 1; + if (code->ext.omp_clauses->orderedc) + collapse = code->ext.omp_clauses->orderedc; + else + { + collapse = code->ext.omp_clauses->collapse; + if (collapse <= 0) + collapse = 1; + } for (i = 1; i <= collapse; i++) { if (do_code->op == EXEC_DO_WHILE) @@ -4972,7 +5911,7 @@ resolve_oacc_loop_blocks (gfc_code *code) } else { - resolve_oacc_positive_int_expr (el->expr, "TILE"); + resolve_positive_int_expr (el->expr, "TILE"); if (el->expr->expr_type != EXPR_CONSTANT) gfc_error ("TILE requires constant expression at %L", &code->loc); @@ -5134,10 +6073,15 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -5152,6 +6096,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TASK: case EXEC_OMP_TEAMS: @@ -5185,7 +6132,8 @@ gfc_resolve_omp_declare_simd (gfc_namespace *ns) for (ods = ns->omp_declare_simd; ods; ods = ods->next) { - if (ods->proc_name != ns->proc_name) + if (ods->proc_name != NULL + && ods->proc_name != ns->proc_name) gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure " "%qs at %L", ns->proc_name->name, &ods->where); if (ods->clauses) diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 0ee054a014c..ec1d0d692bf 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -836,7 +836,7 @@ decode_omp_directive (void) break; case 'e': matcho ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC); - matcho ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL); + matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL); matchs ("end distribute parallel do simd", gfc_match_omp_eos, ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD); matcho ("end distribute parallel do", gfc_match_omp_eos, @@ -860,6 +860,13 @@ decode_omp_directive (void) matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); matcho ("end target data", gfc_match_omp_eos, ST_OMP_END_TARGET_DATA); + matchs ("end target parallel do simd", gfc_match_omp_eos, + ST_OMP_END_TARGET_PARALLEL_DO_SIMD); + matcho ("end target parallel do", gfc_match_omp_eos, + ST_OMP_END_TARGET_PARALLEL_DO); + matcho ("end target parallel", gfc_match_omp_eos, + ST_OMP_END_TARGET_PARALLEL); + matchs ("end target simd", gfc_match_omp_eos, ST_OMP_END_TARGET_SIMD); matchs ("end target teams distribute parallel do simd", gfc_match_omp_eos, ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -872,6 +879,9 @@ decode_omp_directive (void) matcho ("end target teams", gfc_match_omp_eos, ST_OMP_END_TARGET_TEAMS); matcho ("end target", gfc_match_omp_eos, ST_OMP_END_TARGET); matcho ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP); + matchs ("end taskloop simd", gfc_match_omp_eos, + ST_OMP_END_TASKLOOP_SIMD); + matcho ("end taskloop", gfc_match_omp_eos, ST_OMP_END_TASKLOOP); matcho ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); matchs ("end teams distribute parallel do simd", gfc_match_omp_eos, ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -892,7 +902,14 @@ decode_omp_directive (void) matcho ("master", gfc_match_omp_master, ST_OMP_MASTER); break; case 'o': - matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); + if (flag_openmp && gfc_match ("ordered depend (") == MATCH_YES) + { + gfc_current_locus = old_locus; + matcho ("ordered", gfc_match_omp_ordered_depend, + ST_OMP_ORDERED_DEPEND); + } + else + matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); break; case 'p': matchs ("parallel do simd", gfc_match_omp_parallel_do_simd, @@ -912,6 +929,17 @@ decode_omp_directive (void) break; case 't': matcho ("target data", gfc_match_omp_target_data, ST_OMP_TARGET_DATA); + matcho ("target enter data", gfc_match_omp_target_enter_data, + ST_OMP_TARGET_ENTER_DATA); + matcho ("target exit data", gfc_match_omp_target_exit_data, + ST_OMP_TARGET_EXIT_DATA); + matchs ("target parallel do simd", gfc_match_omp_target_parallel_do_simd, + ST_OMP_TARGET_PARALLEL_DO_SIMD); + matcho ("target parallel do", gfc_match_omp_target_parallel_do, + ST_OMP_TARGET_PARALLEL_DO); + matcho ("target parallel", gfc_match_omp_target_parallel, + ST_OMP_TARGET_PARALLEL); + matchs ("target simd", gfc_match_omp_target_simd, ST_OMP_TARGET_SIMD); matchs ("target teams distribute parallel do simd", gfc_match_omp_target_teams_distribute_parallel_do_simd, ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -928,6 +956,9 @@ decode_omp_directive (void) ST_OMP_TARGET_UPDATE); matcho ("target", gfc_match_omp_target, ST_OMP_TARGET); matcho ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP); + matchs ("taskloop simd", gfc_match_omp_taskloop_simd, + ST_OMP_TASKLOOP_SIMD); + matcho ("taskloop", gfc_match_omp_taskloop, ST_OMP_TASKLOOP); matcho ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT); matcho ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD); matcho ("task", gfc_match_omp_task, ST_OMP_TASK); @@ -1423,7 +1454,9 @@ next_statement (void) 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_OMP_TARGET_UPDATE: case ST_ERROR_STOP: case ST_SYNC_ALL: \ + case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ + case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \ + case ST_ERROR_STOP: case ST_SYNC_ALL: \ case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ case ST_EVENT_POST: case ST_EVENT_WAIT: \ case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ @@ -1451,7 +1484,9 @@ next_statement (void) case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: \ case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_DISTRIBUTE: \ case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO: \ - case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: \ + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL: \ + case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \ + case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \ case ST_CRITICAL: \ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \ @@ -2158,6 +2193,18 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TARGET_DATA: p = "!$OMP END TARGET DATA"; break; + case ST_OMP_END_TARGET_PARALLEL: + p = "!$OMP END TARGET PARALLEL"; + break; + case ST_OMP_END_TARGET_PARALLEL_DO: + p = "!$OMP END TARGET PARALLEL DO"; + break; + case ST_OMP_END_TARGET_PARALLEL_DO_SIMD: + p = "!$OMP END TARGET PARALLEL DO SIMD"; + break; + case ST_OMP_END_TARGET_SIMD: + p = "!$OMP END TARGET SIMD"; + break; case ST_OMP_END_TARGET_TEAMS: p = "!$OMP END TARGET TEAMS"; break; @@ -2176,6 +2223,12 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TASKGROUP: p = "!$OMP END TASKGROUP"; break; + case ST_OMP_END_TASKLOOP: + p = "!$OMP END TASKLOOP"; + break; + case ST_OMP_END_TASKLOOP_SIMD: + p = "!$OMP END TASKLOOP SIMD"; + break; case ST_OMP_END_TEAMS: p = "!$OMP END TEAMS"; break; @@ -2201,6 +2254,7 @@ gfc_ascii_statement (gfc_statement st) p = "!$OMP MASTER"; break; case ST_OMP_ORDERED: + case ST_OMP_ORDERED_DEPEND: p = "!$OMP ORDERED"; break; case ST_OMP_PARALLEL: @@ -2236,6 +2290,24 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_TARGET_DATA: p = "!$OMP TARGET DATA"; break; + case ST_OMP_TARGET_ENTER_DATA: + p = "!$OMP TARGET ENTER DATA"; + break; + case ST_OMP_TARGET_EXIT_DATA: + p = "!$OMP TARGET EXIT DATA"; + break; + case ST_OMP_TARGET_PARALLEL: + p = "!$OMP TARGET PARALLEL"; + break; + case ST_OMP_TARGET_PARALLEL_DO: + p = "!$OMP TARGET PARALLEL DO"; + break; + case ST_OMP_TARGET_PARALLEL_DO_SIMD: + p = "!$OMP TARGET PARALLEL DO SIMD"; + break; + case ST_OMP_TARGET_SIMD: + p = "!$OMP TARGET SIMD"; + break; case ST_OMP_TARGET_TEAMS: p = "!$OMP TARGET TEAMS"; break; @@ -2260,6 +2332,12 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_TASKGROUP: p = "!$OMP TASKGROUP"; break; + case ST_OMP_TASKLOOP: + p = "!$OMP TASKLOOP"; + break; + case ST_OMP_TASKLOOP_SIMD: + p = "!$OMP TASKLOOP SIMD"; + break; case ST_OMP_TASKWAIT: p = "!$OMP TASKWAIT"; break; @@ -4660,6 +4738,13 @@ parse_omp_do (gfc_statement omp_st) omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD; break; case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break; + case ST_OMP_TARGET_PARALLEL_DO: + omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO; + break; + case ST_OMP_TARGET_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO_SIMD; + break; + case ST_OMP_TARGET_SIMD: omp_end_st = ST_OMP_END_TARGET_SIMD; break; case ST_OMP_TARGET_TEAMS_DISTRIBUTE: omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE; break; @@ -4672,6 +4757,8 @@ parse_omp_do (gfc_statement omp_st) case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD; break; + case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break; + case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break; case ST_OMP_TEAMS_DISTRIBUTE: omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE; break; @@ -5081,13 +5168,15 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case EXEC_OMP_END_NOWAIT: cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool; break; - case EXEC_OMP_CRITICAL: - if (((cp->ext.omp_name == NULL) ^ (new_st.ext.omp_name == NULL)) + case EXEC_OMP_END_CRITICAL: + if (((cp->ext.omp_clauses == NULL) ^ (new_st.ext.omp_name == NULL)) || (new_st.ext.omp_name != NULL - && strcmp (cp->ext.omp_name, new_st.ext.omp_name) != 0)) + && strcmp (cp->ext.omp_clauses->critical_name, + new_st.ext.omp_name) != 0)) gfc_error ("Name after !$omp critical and !$omp end critical does " "not match at %C"); free (CONST_CAST (char *, new_st.ext.omp_name)); + new_st.ext.omp_name = NULL; break; case EXEC_OMP_END_SINGLE: cp->ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE] @@ -5230,6 +5319,7 @@ parse_executable (gfc_statement st) case ST_OMP_SINGLE: case ST_OMP_TARGET: case ST_OMP_TARGET_DATA: + case ST_OMP_TARGET_PARALLEL: case ST_OMP_TARGET_TEAMS: case ST_OMP_TEAMS: case ST_OMP_TASK: @@ -5251,10 +5341,14 @@ parse_executable (gfc_statement st) case ST_OMP_PARALLEL_DO: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_SIMD: + case ST_OMP_TARGET_PARALLEL_DO: + case ST_OMP_TARGET_PARALLEL_DO_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TASKLOOP: + case ST_OMP_TASKLOOP_SIMD: case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f4d346ed0f3..faf7dde4183 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9821,6 +9821,12 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -9829,6 +9835,8 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: @@ -10744,6 +10752,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -10764,6 +10775,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: gfc_resolve_omp_do_blocks (code, ns); break; case EXEC_SELECT_TYPE: @@ -11159,6 +11173,12 @@ start: case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -11167,6 +11187,8 @@ start: case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 7395497dcb6..9af58fc1dce 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -207,6 +207,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_ROUTINE: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: + case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -214,15 +215,23 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_END_SINGLE: + 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_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -230,17 +239,18 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS: case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: - case EXEC_OMP_PARALLEL_WORKSHARE: gfc_free_omp_clauses (p->ext.omp_clauses); break; - case EXEC_OMP_CRITICAL: + case EXEC_OMP_END_CRITICAL: free (CONST_CAST (char *, p->ext.omp_name)); break; @@ -252,7 +262,6 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_MASTER: - case EXEC_OMP_ORDERED: case EXEC_OMP_END_NOWAIT: case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 85ed375e297..0b711ca20b4 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -385,6 +385,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC"; static const char *threadprivate = "THREADPRIVATE"; static const char *omp_declare_target = "OMP DECLARE TARGET"; + static const char *omp_declare_target_link = "OMP DECLARE TARGET LINK"; static const char *oacc_declare_copyin = "OACC DECLARE COPYIN"; static const char *oacc_declare_create = "OACC DECLARE CREATE"; static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR"; @@ -482,6 +483,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (dummy, intrinsic); conf (dummy, threadprivate); conf (dummy, omp_declare_target); + conf (dummy, omp_declare_target_link); conf (pointer, target); conf (pointer, intrinsic); conf (pointer, elemental); @@ -532,6 +534,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (in_equivalence, allocatable); conf (in_equivalence, threadprivate); conf (in_equivalence, omp_declare_target); + conf (in_equivalence, omp_declare_target_link); conf (in_equivalence, oacc_declare_create); conf (in_equivalence, oacc_declare_copyin); conf (in_equivalence, oacc_declare_deviceptr); @@ -540,6 +543,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (dummy, result); conf (entry, result); conf (generic, result); + conf (generic, omp_declare_target); + conf (generic, omp_declare_target_link); conf (function, subroutine); @@ -585,6 +590,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (cray_pointee, in_equivalence); conf (cray_pointee, threadprivate); conf (cray_pointee, omp_declare_target); + conf (cray_pointee, omp_declare_target_link); conf (cray_pointee, oacc_declare_create); conf (cray_pointee, oacc_declare_copyin); conf (cray_pointee, oacc_declare_deviceptr); @@ -641,8 +647,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (procedure, entry) conf (proc_pointer, abstract) + conf (proc_pointer, omp_declare_target) + conf (proc_pointer, omp_declare_target_link) conf (entry, omp_declare_target) + conf (entry, omp_declare_target_link) conf (entry, oacc_declare_create) conf (entry, oacc_declare_copyin) conf (entry, oacc_declare_deviceptr) @@ -684,6 +693,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (subroutine); conf2 (threadprivate); conf2 (omp_declare_target); + conf2 (omp_declare_target_link); conf2 (oacc_declare_create); conf2 (oacc_declare_copyin); conf2 (oacc_declare_deviceptr); @@ -734,6 +744,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) if (!attr->proc_pointer) conf2 (in_common); + conf2 (omp_declare_target_link); + switch (attr->proc) { case PROC_ST_FUNCTION: @@ -770,6 +782,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (threadprivate); conf2 (result); conf2 (omp_declare_target); + conf2 (omp_declare_target_link); conf2 (oacc_declare_create); conf2 (oacc_declare_copyin); conf2 (oacc_declare_deviceptr); @@ -1300,6 +1313,22 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name, bool +gfc_add_omp_declare_target_link (symbol_attribute *attr, const char *name, + locus *where) +{ + + if (check_used (attr, name, where)) + return false; + + if (attr->omp_declare_target_link) + return true; + + attr->omp_declare_target_link = 1; + return check_conflict (attr, name, where); +} + + +bool gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, locus *where) { @@ -1938,6 +1967,9 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) if (src->omp_declare_target && !gfc_add_omp_declare_target (dest, NULL, where)) goto fail; + if (src->omp_declare_target_link + && !gfc_add_omp_declare_target_link (dest, NULL, where)) + goto fail; if (src->oacc_declare_create && !gfc_add_oacc_declare_create (dest, NULL, where)) goto fail; diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 0c030584b68..cd06e154ef3 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -457,7 +457,11 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) if (com->threadprivate) set_decl_tls_model (decl, decl_default_tls_model (decl)); - if (com->omp_declare_target) + if (com->omp_declare_target_link) + DECL_ATTRIBUTES (decl) + = tree_cons (get_identifier ("omp declare target link"), + NULL_TREE, DECL_ATTRIBUTES (decl)); + else if (com->omp_declare_target) DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("omp declare target"), NULL_TREE, DECL_ATTRIBUTES (decl)); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4f8ef17dda6..7c9730c7a85 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1376,7 +1376,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = chainon (list, attr); } - if (sym_attr.omp_declare_target) + if (sym_attr.omp_declare_target_link) + list = tree_cons (get_identifier ("omp declare target link"), + NULL_TREE, list); + else if (sym_attr.omp_declare_target) list = tree_cons (get_identifier ("omp declare target"), NULL_TREE, list); diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index febff255438..59fd6b3e6a0 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1140,6 +1140,34 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) } +/* Return true if DECL is a scalar variable (for the purpose of + implicit firstprivatization). */ + +bool +gfc_omp_scalar_p (tree decl) +{ + tree type = TREE_TYPE (decl); + if (TREE_CODE (type) == REFERENCE_TYPE) + type = TREE_TYPE (type); + if (TREE_CODE (type) == POINTER_TYPE) + { + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) + || GFC_DECL_GET_SCALAR_POINTER (decl)) + type = TREE_TYPE (type); + if (GFC_ARRAY_TYPE_P (type) + || GFC_CLASS_TYPE_P (type)) + return false; + } + if (TYPE_STRING_FLAG (type)) + return false; + if (INTEGRAL_TYPE_P (type) + || SCALAR_FLOAT_TYPE_P (type) + || COMPLEX_FLOAT_TYPE_P (type)) + return true; + return false; +} + + /* Return true if DECL's DECL_VALUE_EXPR (if any) should be disregarded in OpenMP construct, because it is going to be remapped during OpenMP lowering. SHARED is true if DECL @@ -1727,12 +1755,14 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr) return result; } +static vec<tree, va_heap, vl_embed> *doacross_steps; + static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where, bool declare_simd = false) { tree omp_clauses = NULL_TREE, chunk_size, c; - int list; + int list, ifc; enum omp_clause_code clause_code; gfc_se se; @@ -1775,8 +1805,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, clause_code = OMP_CLAUSE_UNIFORM; goto add_clause; case OMP_LIST_USE_DEVICE: + case OMP_LIST_USE_DEVICE_PTR: clause_code = OMP_CLAUSE_USE_DEVICE_PTR; goto add_clause; + case OMP_LIST_IS_DEVICE_PTR: + clause_code = OMP_CLAUSE_IS_DEVICE_PTR; + goto add_clause; add_clause: omp_clauses @@ -1797,7 +1831,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree alignment_var; - if (block == NULL) + if (declare_simd) alignment_var = gfc_conv_constant_to_tree (n->expr); else { @@ -1817,6 +1851,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { gfc_expr *last_step_expr = NULL; tree last_step = NULL_TREE; + bool last_step_parm = false; for (; n != NULL; n = n->next) { @@ -1824,6 +1859,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { last_step_expr = n->expr; last_step = NULL_TREE; + last_step_parm = false; } if (n->sym->attr.referenced || declare_simd) { @@ -1833,12 +1869,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree node = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); OMP_CLAUSE_DECL (node) = t; + omp_clause_linear_kind kind; + switch (n->u.linear_op) + { + case OMP_LINEAR_DEFAULT: + kind = OMP_CLAUSE_LINEAR_DEFAULT; + break; + case OMP_LINEAR_REF: + kind = OMP_CLAUSE_LINEAR_REF; + break; + case OMP_LINEAR_VAL: + kind = OMP_CLAUSE_LINEAR_VAL; + break; + case OMP_LINEAR_UVAL: + kind = OMP_CLAUSE_LINEAR_UVAL; + break; + default: + gcc_unreachable (); + } + OMP_CLAUSE_LINEAR_KIND (node) = kind; if (last_step_expr && last_step == NULL_TREE) { - if (block == NULL) - last_step - = gfc_conv_constant_to_tree (last_step_expr); - else + if (!declare_simd) { gfc_init_se (&se, NULL); gfc_conv_expr (&se, last_step_expr); @@ -1846,10 +1898,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, last_step = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); } + else if (last_step_expr->expr_type == EXPR_VARIABLE) + { + gfc_symbol *s = last_step_expr->symtree->n.sym; + last_step = gfc_trans_omp_variable (s, true); + last_step_parm = true; + } + else + last_step + = gfc_conv_constant_to_tree (last_step_expr); + } + if (last_step_parm) + { + OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1; + OMP_CLAUSE_LINEAR_STEP (node) = last_step; + } + else + { + tree type = gfc_typenode_for_spec (&n->sym->ts); + OMP_CLAUSE_LINEAR_STEP (node) + = fold_convert (type, last_step); } - OMP_CLAUSE_LINEAR_STEP (node) - = fold_convert (gfc_typenode_for_spec (&n->sym->ts), - last_step); if (n->sym->attr.dimension || n->sym->attr.allocatable) OMP_CLAUSE_LINEAR_ARRAY (node) = 1; omp_clauses = gfc_trans_add_clause (node, omp_clauses); @@ -1861,6 +1930,57 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_DEPEND: for (; n != NULL; n = n->next) { + if (n->u.depend_op == OMP_DEPEND_SINK_FIRST) + { + tree vec = NULL_TREE; + unsigned int i; + for (i = 0; ; i++) + { + tree addend = integer_zero_node, t; + bool neg = false; + if (n->expr) + { + addend = gfc_conv_constant_to_tree (n->expr); + if (TREE_CODE (addend) == INTEGER_CST + && tree_int_cst_sgn (addend) == -1) + { + neg = true; + addend = const_unop (NEGATE_EXPR, + TREE_TYPE (addend), addend); + } + } + t = gfc_trans_omp_variable (n->sym, false); + if (t != error_mark_node) + { + if (i < vec_safe_length (doacross_steps) + && !integer_zerop (addend) + && (*doacross_steps)[i]) + { + tree step = (*doacross_steps)[i]; + addend = fold_convert (TREE_TYPE (step), addend); + addend = build2 (TRUNC_DIV_EXPR, + TREE_TYPE (step), addend, step); + } + vec = tree_cons (addend, t, vec); + if (neg) + OMP_CLAUSE_DEPEND_SINK_NEGATIVE (vec) = 1; + } + if (n->next == NULL + || n->next->u.depend_op != OMP_DEPEND_SINK) + break; + n = n->next; + } + if (vec == NULL_TREE) + continue; + + tree node = build_omp_clause (input_location, + OMP_CLAUSE_DEPEND); + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_SINK; + OMP_CLAUSE_DECL (node) = nreverse (vec); + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + continue; + } + if (!n->sym->attr.referenced) continue; @@ -2120,6 +2240,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_MAP_TOFROM: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM); break; + case OMP_MAP_ALWAYS_TO: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO); + break; + case OMP_MAP_ALWAYS_FROM: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM); + break; + case OMP_MAP_ALWAYS_TOFROM: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM); + break; + case OMP_MAP_RELEASE: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_RELEASE); + break; case OMP_MAP_DELETE: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DELETE); break; @@ -2260,6 +2392,50 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_IF_EXPR (c) = if_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + for (ifc = 0; ifc < OMP_IF_LAST; ifc++) + if (clauses->if_exprs[ifc]) + { + tree if_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->if_exprs[ifc]); + gfc_add_block_to_block (block, &se.pre); + if_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF); + switch (ifc) + { + case OMP_IF_PARALLEL: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_PARALLEL; + break; + case OMP_IF_TASK: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASK; + break; + case OMP_IF_TASKLOOP: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASKLOOP; + break; + case OMP_IF_TARGET: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET; + break; + case OMP_IF_TARGET_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_DATA; + break; + case OMP_IF_TARGET_UPDATE: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_UPDATE; + break; + case OMP_IF_TARGET_ENTER_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_ENTER_DATA; + break; + case OMP_IF_TARGET_EXIT_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_EXIT_DATA; + break; + default: + gcc_unreachable (); + } + OMP_CLAUSE_IF_EXPR (c) = if_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } if (clauses->final_expr) { @@ -2325,6 +2501,16 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, default: gcc_unreachable (); } + if (clauses->sched_monotonic) + OMP_CLAUSE_SCHEDULE_KIND (c) + = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c) + | OMP_CLAUSE_SCHEDULE_MONOTONIC); + else if (clauses->sched_nonmonotonic) + OMP_CLAUSE_SCHEDULE_KIND (c) + = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c) + | OMP_CLAUSE_SCHEDULE_NONMONOTONIC); + if (clauses->sched_simd) + OMP_CLAUSE_SCHEDULE_SIMD (c) = 1; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2360,7 +2546,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->ordered) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED); - OMP_CLAUSE_ORDERED_EXPR (c) = NULL_TREE; + OMP_CLAUSE_ORDERED_EXPR (c) + = clauses->orderedc ? build_int_cst (integer_type_node, + clauses->orderedc) : NULL_TREE; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2455,10 +2643,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *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); + if (declare_simd) + { + 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); + } + else + { + tree simdlen_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->simdlen_expr); + gfc_add_block_to_block (block, &se.pre); + simdlen_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } } if (clauses->num_teams) @@ -2523,6 +2728,93 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->grainsize) + { + tree grainsize; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->grainsize); + gfc_add_block_to_block (block, &se.pre); + grainsize = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_GRAINSIZE); + OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->num_tasks) + { + tree num_tasks; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->num_tasks); + gfc_add_block_to_block (block, &se.pre); + num_tasks = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TASKS); + OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->priority) + { + tree priority; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->priority); + gfc_add_block_to_block (block, &se.pre); + priority = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PRIORITY); + OMP_CLAUSE_PRIORITY_EXPR (c) = priority; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->hint) + { + tree hint; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->hint); + gfc_add_block_to_block (block, &se.pre); + hint = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_HINT); + OMP_CLAUSE_HINT_EXPR (c) = hint; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->simd) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMD); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->threads) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREADS); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->nogroup) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOGROUP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->defaultmap) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->depend_source) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEPEND); + OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->async) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC); @@ -3135,8 +3427,8 @@ static tree gfc_trans_omp_critical (gfc_code *code) { tree name = NULL_TREE, stmt; - if (code->ext.omp_name != NULL) - name = get_identifier (code->ext.omp_name); + if (code->ext.omp_clauses != NULL) + name = get_identifier (code->ext.omp_clauses->critical_name); stmt = gfc_trans_code (code->block->next); return build3_loc (input_location, OMP_CRITICAL, void_type_node, stmt, NULL_TREE, name); @@ -3153,7 +3445,7 @@ 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; - tree dovar, stmt, from, to, step, type, init, cond, incr; + tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls; tree count = NULL_TREE, cycle_label, tmp, omp_clauses; stmtblock_t block; stmtblock_t body; @@ -3162,7 +3454,11 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, vec<dovar_init> inits = vNULL; dovar_init *di; unsigned ix; + vec<tree, va_heap, vl_embed> *saved_doacross_steps = doacross_steps; + doacross_steps = NULL; + if (clauses->orderedc) + collapse = clauses->orderedc; if (collapse <= 0) collapse = 1; @@ -3172,6 +3468,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, init = make_tree_vec (collapse); cond = make_tree_vec (collapse); incr = make_tree_vec (collapse); + orig_decls = clauses->orderedc ? make_tree_vec (collapse) : NULL_TREE; if (pblock == NULL) { @@ -3179,6 +3476,11 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, pblock = █ } + /* simd schedule modifier is only useful for composite do simd and other + constructs including that, where gfc_trans_omp_do is only called + on the simd construct and DO's clauses are translated elsewhere. */ + do_clauses->sched_simd = false; + omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc); for (i = 0; i < collapse; i++) @@ -3291,7 +3593,15 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp); dovar_init e = {dovar, tmp}; inits.safe_push (e); + if (clauses->orderedc) + { + if (doacross_steps == NULL) + vec_safe_grow_cleared (doacross_steps, clauses->orderedc); + (*doacross_steps)[i] = step; + } } + if (orig_decls) + TREE_VEC_ELT (orig_decls, i) = dovar_decl; if (dovar_found == 2 && op == EXEC_OMP_SIMD @@ -3338,9 +3648,24 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar will have the value on entry of the last loop, rather than value after iterator increment. */ - tmp = gfc_evaluate_now (step, pblock); - tmp = fold_build2_loc (input_location, PLUS_EXPR, type, dovar, - tmp); + if (clauses->orderedc) + { + if (clauses->collapse <= 1 || i >= clauses->collapse) + tmp = count; + else + tmp = fold_build2_loc (input_location, PLUS_EXPR, + type, count, build_one_cst (type)); + tmp = fold_build2_loc (input_location, MULT_EXPR, type, + tmp, step); + tmp = fold_build2_loc (input_location, PLUS_EXPR, type, + from, tmp); + } + else + { + tmp = gfc_evaluate_now (step, pblock); + tmp = fold_build2_loc (input_location, PLUS_EXPR, type, + dovar, tmp); + } tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, dovar, tmp); for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) @@ -3434,6 +3759,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break; case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break; case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break; + case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break; case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break; default: gcc_unreachable (); } @@ -3444,8 +3770,13 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, OMP_FOR_INIT (stmt) = init; OMP_FOR_COND (stmt) = cond; OMP_FOR_INCR (stmt) = incr; + if (orig_decls) + OMP_FOR_ORIG_DECLS (stmt) = orig_decls; gfc_add_expr_to_block (&block, stmt); + vec_free (doacross_steps); + doacross_steps = saved_doacross_steps; + return gfc_finish_block (&block); } @@ -3547,8 +3878,11 @@ gfc_trans_omp_master (gfc_code *code) static tree gfc_trans_omp_ordered (gfc_code *code) { + tree omp_clauses = gfc_trans_omp_clauses (NULL, code->ext.omp_clauses, + code->loc); return build2_loc (input_location, OMP_ORDERED, void_type_node, - gfc_trans_code (code->block->next), NULL_TREE); + code->block ? gfc_trans_code (code->block->next) + : NULL_TREE, omp_clauses); } static tree @@ -3577,6 +3911,7 @@ enum GFC_OMP_SPLIT_DISTRIBUTE, GFC_OMP_SPLIT_TEAMS, GFC_OMP_SPLIT_TARGET, + GFC_OMP_SPLIT_TASKLOOP, GFC_OMP_SPLIT_NUM }; @@ -3587,7 +3922,8 @@ enum GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL), GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE), GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS), - GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET) + GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET), + GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP) }; static void @@ -3638,6 +3974,23 @@ gfc_split_omp_clauses (gfc_code *code, case EXEC_OMP_TARGET: innermost = GFC_OMP_SPLIT_TARGET; break; + case EXEC_OMP_TARGET_PARALLEL: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL; + innermost = GFC_OMP_SPLIT_PARALLEL; + break; + case EXEC_OMP_TARGET_PARALLEL_DO: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO + | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TARGET_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_TARGET_TEAMS: mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS; innermost = GFC_OMP_SPLIT_TEAMS; @@ -3662,6 +4015,13 @@ gfc_split_omp_clauses (gfc_code *code, | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_TASKLOOP: + innermost = GFC_OMP_SPLIT_TASKLOOP; + break; + case EXEC_OMP_TASKLOOP_SIMD: + mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_TEAMS: innermost = GFC_OMP_SPLIT_TEAMS; break; @@ -3698,8 +4058,17 @@ gfc_split_omp_clauses (gfc_code *code, /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP] = code->ext.omp_clauses->lists[OMP_LIST_MAP]; + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR] + = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR]; clausesa[GFC_OMP_SPLIT_TARGET].device = code->ext.omp_clauses->device; + clausesa[GFC_OMP_SPLIT_TARGET].defaultmap + = code->ext.omp_clauses->defaultmap; + clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET] + = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET]; + /* And this is copied to all. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; } if (mask & GFC_OMP_MASK_TEAMS) { @@ -3708,7 +4077,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->num_teams; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = code->ext.omp_clauses->thread_limit; - /* Shared and default clauses are allowed on parallel and teams. */ + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED] = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing @@ -3734,19 +4104,34 @@ gfc_split_omp_clauses (gfc_code *code, = 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. */ + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ 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; + clausesa[GFC_OMP_SPLIT_PARALLEL].if_exprs[OMP_IF_PARALLEL] + = code->ext.omp_clauses->if_exprs[OMP_IF_PARALLEL]; + /* And this is copied to all. */ + 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].orderedc + = code->ext.omp_clauses->orderedc; clausesa[GFC_OMP_SPLIT_DO].sched_kind = code->ext.omp_clauses->sched_kind; + if (innermost == GFC_OMP_SPLIT_SIMD) + clausesa[GFC_OMP_SPLIT_DO].sched_simd + = code->ext.omp_clauses->sched_simd; + clausesa[GFC_OMP_SPLIT_DO].sched_monotonic + = code->ext.omp_clauses->sched_monotonic; + clausesa[GFC_OMP_SPLIT_DO].sched_nonmonotonic + = code->ext.omp_clauses->sched_nonmonotonic; clausesa[GFC_OMP_SPLIT_DO].chunk_size = code->ext.omp_clauses->chunk_size; clausesa[GFC_OMP_SPLIT_DO].nowait @@ -3759,25 +4144,60 @@ gfc_split_omp_clauses (gfc_code *code, { 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].simdlen_expr + = code->ext.omp_clauses->simdlen_expr; 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, + if (mask & GFC_OMP_MASK_TASKLOOP) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].nogroup + = code->ext.omp_clauses->nogroup; + clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize + = code->ext.omp_clauses->grainsize; + clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks + = code->ext.omp_clauses->num_tasks; + clausesa[GFC_OMP_SPLIT_TASKLOOP].priority + = code->ext.omp_clauses->priority; + clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr + = code->ext.omp_clauses->final_expr; + clausesa[GFC_OMP_SPLIT_TASKLOOP].untied + = code->ext.omp_clauses->untied; + clausesa[GFC_OMP_SPLIT_TASKLOOP].mergeable + = code->ext.omp_clauses->mergeable; + clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP] + = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP]; + /* And this is copied to all. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr + = code->ext.omp_clauses->if_expr; + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_TASKLOOP].default_sharing + = code->ext.omp_clauses->default_sharing; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse + = code->ext.omp_clauses->collapse; + } + /* Private clause is supported on all constructs, it is enough to put it on the innermost one. For - !$ omp do put it on parallel though, + !$ omp parallel 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. */ + simd. Put it on the outermost of those and duplicate + on parallel and teams. */ + if (mask & GFC_OMP_MASK_TARGET) + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; if (mask & GFC_OMP_MASK_TEAMS) clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; @@ -3790,9 +4210,12 @@ gfc_split_omp_clauses (gfc_code *code, 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 + /* Lastprivate is allowed on distribute, do and simd. + In parallel do{, simd} we actually want to put it on parallel rather than do. */ + if (mask & GFC_OMP_MASK_DISTRIBUTE) + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; if (mask & GFC_OMP_MASK_PARALLEL) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; @@ -3817,13 +4240,10 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_SIMD) clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_REDUCTION] = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; - /* FIXME: This is currently being discussed. */ - if (mask & GFC_OMP_MASK_PARALLEL) - clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr - = code->ext.omp_clauses->if_expr; - else - clausesa[GFC_OMP_SPLIT_TARGET].if_expr - = code->ext.omp_clauses->if_expr; + /* Linear clause is supported on do and simd, + put it on the innermost one. */ + clausesa[innermost].lists[OMP_LIST_LINEAR] + = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; } if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) @@ -4166,11 +4586,12 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa) } static tree -gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa) +gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa, + tree omp_clauses) { stmtblock_t block; gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; - tree stmt, omp_clauses = NULL_TREE; + tree stmt; bool combined = true; gfc_start_block (&block); @@ -4181,8 +4602,9 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa) } if (flag_openmp) omp_clauses - = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS], - code->loc); + = chainon (omp_clauses, + gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS], + code->loc)); switch (code->op) { case EXEC_OMP_TARGET_TEAMS: @@ -4200,10 +4622,13 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa) stmt = gfc_trans_omp_distribute (code, clausesa); break; } - stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt, - omp_clauses); - if (combined) - OMP_TEAMS_COMBINED (stmt) = 1; + if (flag_openmp) + { + stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt, + omp_clauses); + if (combined) + OMP_TEAMS_COMBINED (stmt) = 1; + } gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); } @@ -4221,24 +4646,128 @@ gfc_trans_omp_target (gfc_code *code) omp_clauses = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET], code->loc); - if (code->op == EXEC_OMP_TARGET) + switch (code->op) { + case EXEC_OMP_TARGET: pushlevel (); stmt = gfc_trans_omp_code (code->block->next, true); stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + break; + case EXEC_OMP_TARGET_PARALLEL: + { + stmtblock_t iblock; + + gfc_start_block (&iblock); + tree inner_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, + inner_clauses); + gfc_add_expr_to_block (&iblock, stmt); + stmt = gfc_finish_block (&iblock); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + } + break; + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + case EXEC_OMP_TARGET_SIMD: + stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block, + &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + default: + if (flag_openmp + && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams + || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit)) + { + gfc_omp_clauses clausesb; + tree teams_clauses; + /* For combined !$omp target teams, the num_teams and + thread_limit clauses are evaluated before entering the + target construct. */ + memset (&clausesb, '\0', sizeof (clausesb)); + clausesb.num_teams = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams; + clausesb.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL; + teams_clauses + = gfc_trans_omp_clauses (&block, &clausesb, code->loc); + pushlevel (); + stmt = gfc_trans_omp_teams (code, clausesa, teams_clauses); + } + else + { + pushlevel (); + stmt = gfc_trans_omp_teams (code, clausesa, NULL_TREE); + } + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; } - else + if (flag_openmp) { - pushlevel (); - stmt = gfc_trans_omp_teams (code, clausesa); + stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt, + omp_clauses); + if (code->op != EXEC_OMP_TARGET) + OMP_TARGET_COMBINED (stmt) = 1; + } + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_taskloop (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); + if (flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TASKLOOP], + code->loc); + switch (code->op) + { + case EXEC_OMP_TASKLOOP: + /* This is handled in gfc_trans_omp_do. */ + gcc_unreachable (); + break; + case EXEC_OMP_TASKLOOP_SIMD: + stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block, + &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else poplevel (0, 0); + break; + default: + gcc_unreachable (); } if (flag_openmp) - stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt, - omp_clauses); + { + tree taskloop = make_node (OMP_TASKLOOP); + TREE_TYPE (taskloop) = void_type_node; + OMP_FOR_BODY (taskloop) = stmt; + OMP_FOR_CLAUSES (taskloop) = omp_clauses; + stmt = taskloop; + } gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); } @@ -4260,6 +4789,36 @@ gfc_trans_omp_target_data (gfc_code *code) } static tree +gfc_trans_omp_target_enter_data (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_target_exit_data (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_target_update (gfc_code *code) { stmtblock_t block; @@ -4503,6 +5062,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: case EXEC_OMP_SIMD: + case EXEC_OMP_TASKLOOP: return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, NULL); case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: @@ -4532,6 +5092,10 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_SINGLE: return gfc_trans_omp_single (code, code->ext.omp_clauses); case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -4540,12 +5104,18 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_target (code); case EXEC_OMP_TARGET_DATA: return gfc_trans_omp_target_data (code); + case EXEC_OMP_TARGET_ENTER_DATA: + return gfc_trans_omp_target_enter_data (code); + case EXEC_OMP_TARGET_EXIT_DATA: + return gfc_trans_omp_target_exit_data (code); case EXEC_OMP_TARGET_UPDATE: return gfc_trans_omp_target_update (code); case EXEC_OMP_TASK: return gfc_trans_omp_task (code); case EXEC_OMP_TASKGROUP: return gfc_trans_omp_taskgroup (code); + case EXEC_OMP_TASKLOOP_SIMD: + return gfc_trans_omp_taskloop (code); case EXEC_OMP_TASKWAIT: return gfc_trans_omp_taskwait (); case EXEC_OMP_TASKYIELD: @@ -4555,7 +5125,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: - return gfc_trans_omp_teams (code, NULL); + return gfc_trans_omp_teams (code, NULL, NULL_TREE); case EXEC_OMP_WORKSHARE: return gfc_trans_omp_workshare (code, code->ext.omp_clauses); default: diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index dc2f068768f..aaec1c22753 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1930,6 +1930,12 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -1938,6 +1944,8 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 4306200eb03..02a8a564250 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -742,6 +742,7 @@ tree gfc_omp_clause_assign_op (tree, tree, tree); tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree); tree gfc_omp_clause_dtor (tree, tree); void gfc_omp_finish_clause (tree, gimple_seq *); +bool gfc_omp_scalar_p (tree); bool gfc_omp_disregard_value_expr (tree, bool); bool gfc_omp_private_debug_clause (tree, bool); bool gfc_omp_private_outer_ref (tree); diff --git a/gcc/gimplify.c b/gcc/gimplify.c index da60c053de2..16573ddaba9 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -7011,17 +7011,7 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code) is_declare_target = octx == NULL; } if (!is_declare_target && ctx->target_map_scalars_firstprivate) - { - tree type = TREE_TYPE (decl); - if (TREE_CODE (type) == REFERENCE_TYPE) - type = TREE_TYPE (type); - if (TREE_CODE (type) == COMPLEX_TYPE) - type = TREE_TYPE (type); - if (INTEGRAL_TYPE_P (type) - || SCALAR_FLOAT_TYPE_P (type) - || TREE_CODE (type) == POINTER_TYPE) - is_scalar = true; - } + is_scalar = lang_hooks.decls.omp_scalar_p (decl); if (is_declare_target) ; else if (ctx->target_map_pointers_as_0len_arrays @@ -7293,36 +7283,6 @@ omp_check_private (struct gimplify_omp_ctx *ctx, tree decl, bool copyprivate) return false; } -/* Return true if the CTX is combined with distribute and thus - lastprivate can't be supported. */ - -static bool -omp_no_lastprivate (struct gimplify_omp_ctx *ctx) -{ - do - { - if (ctx->outer_context == NULL) - return false; - ctx = ctx->outer_context; - switch (ctx->region_type) - { - case ORT_WORKSHARE: - if (!ctx->combined_loop) - return false; - if (ctx->distribute) - return lang_GNU_Fortran (); - break; - case ORT_COMBINED_PARALLEL: - break; - case ORT_COMBINED_TEAMS: - return lang_GNU_Fortran (); - default: - return false; - } - } - while (1); -} - /* Callback for walk_tree to find a DECL_EXPR for the given DECL. */ static tree @@ -7354,11 +7314,10 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, ctx = new_omp_context (region_type); outer_ctx = ctx->outer_context; - if (code == OMP_TARGET && !lang_GNU_Fortran ()) + if (code == OMP_TARGET) { - ctx->target_map_pointers_as_0len_arrays = true; - /* FIXME: For Fortran we want to set this too, when - the Fortran FE is updated to OpenMP 4.5. */ + if (!lang_GNU_Fortran ()) + ctx->target_map_pointers_as_0len_arrays = true; ctx->target_map_scalars_firstprivate = true; } if (!lang_GNU_Fortran ()) @@ -7405,12 +7364,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, flags = GOVD_LASTPRIVATE | GOVD_SEEN | GOVD_EXPLICIT; check_non_private = "lastprivate"; decl = OMP_CLAUSE_DECL (c); - if (omp_no_lastprivate (ctx)) - { - notice_outer = false; - flags |= GOVD_LINEAR_LASTPRIVATE_NO_OUTER; - } - else if (error_operand_p (decl)) + if (error_operand_p (decl)) goto do_add; else if (outer_ctx && (outer_ctx->region_type == ORT_COMBINED_PARALLEL @@ -7450,7 +7404,31 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, struct gimplify_omp_ctx *octx = outer_ctx->outer_context; omp_add_variable (octx, decl, GOVD_SHARED | GOVD_SEEN); if (octx->outer_context) - omp_notice_variable (octx->outer_context, decl, true); + { + octx = octx->outer_context; + if (octx->region_type == ORT_WORKSHARE + && octx->combined_loop + && splay_tree_lookup (octx->variables, + (splay_tree_key) decl) == NULL + && !omp_check_private (octx, decl, false)) + { + omp_add_variable (octx, decl, + GOVD_LASTPRIVATE | GOVD_SEEN); + octx = octx->outer_context; + if (octx + && octx->region_type == ORT_COMBINED_TEAMS + && (splay_tree_lookup (octx->variables, + (splay_tree_key) decl) + == NULL)) + { + omp_add_variable (octx, decl, + GOVD_SHARED | GOVD_SEEN); + octx = octx->outer_context; + } + } + if (octx) + omp_notice_variable (octx, decl, true); + } } else if (outer_ctx->outer_context) omp_notice_variable (outer_ctx->outer_context, decl, true); @@ -7529,8 +7507,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, if (octx && octx->region_type == ORT_WORKSHARE && octx->combined_loop - && octx->distribute - && !lang_GNU_Fortran ()) + && octx->distribute) { error_at (OMP_CLAUSE_LOCATION (c), "%<linear%> clause for variable other than " @@ -7545,8 +7522,6 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, parallel. Similarly for #pragma omp for simd. */ struct gimplify_omp_ctx *octx = outer_ctx; decl = NULL_TREE; - if (omp_no_lastprivate (ctx)) - OMP_CLAUSE_LINEAR_NO_COPYOUT (c) = 1; do { if (OMP_CLAUSE_LINEAR_NO_COPYIN (c) @@ -8052,13 +8027,21 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, goto do_add; case OMP_CLAUSE_DEPEND: - if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK - || OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SOURCE) + if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK) { - /* Nothing to do. OMP_CLAUSE_DECL will be lowered in - omp-low.c. */ + tree deps = OMP_CLAUSE_DECL (c); + while (deps && TREE_CODE (deps) == TREE_LIST) + { + if (TREE_CODE (TREE_PURPOSE (deps)) == TRUNC_DIV_EXPR + && DECL_P (TREE_OPERAND (TREE_PURPOSE (deps), 1))) + gimplify_expr (&TREE_OPERAND (TREE_PURPOSE (deps), 1), + pre_p, NULL, is_gimple_val, fb_rvalue); + deps = TREE_CHAIN (deps); + } break; } + else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SOURCE) + break; if (TREE_CODE (OMP_CLAUSE_DECL (c)) == COMPOUND_EXPR) { gimplify_expr (&TREE_OPERAND (OMP_CLAUSE_DECL (c), 0), pre_p, @@ -8822,15 +8805,8 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p, n = splay_tree_lookup (ctx->variables, (splay_tree_key) decl); OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (c) = (n->value & GOVD_FIRSTPRIVATE) != 0; - if (omp_no_lastprivate (ctx)) - { - if (OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (c)) - remove = true; - else - OMP_CLAUSE_CODE (c) = OMP_CLAUSE_PRIVATE; - } - else if (code == OMP_DISTRIBUTE - && OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (c)) + if (code == OMP_DISTRIBUTE + && OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (c)) { remove = true; error_at (OMP_CLAUSE_LOCATION (c), @@ -9629,9 +9605,8 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) c = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); OMP_CLAUSE_LINEAR_NO_COPYIN (c) = 1; unsigned int flags = GOVD_LINEAR | GOVD_EXPLICIT | GOVD_SEEN; - if ((has_decl_expr - && bitmap_bit_p (has_decl_expr, DECL_UID (decl))) - || omp_no_lastprivate (gimplify_omp_ctxp)) + if (has_decl_expr + && bitmap_bit_p (has_decl_expr, DECL_UID (decl))) { OMP_CLAUSE_LINEAR_NO_COPYOUT (c) = 1; flags |= GOVD_LINEAR_LASTPRIVATE_NO_OUTER; @@ -9752,8 +9727,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) { bool lastprivate = (!has_decl_expr - || !bitmap_bit_p (has_decl_expr, DECL_UID (decl))) - && !omp_no_lastprivate (gimplify_omp_ctxp); + || !bitmap_bit_p (has_decl_expr, DECL_UID (decl))); struct gimplify_omp_ctx *outer = gimplify_omp_ctxp->outer_context; if (outer && lastprivate) @@ -10323,6 +10297,11 @@ computable_teams_clause (tree *tp, int *walk_subtrees, void *) || lookup_attribute ("omp declare target link", DECL_ATTRIBUTES (*tp)))) return *tp; + if (VAR_P (*tp) + && !DECL_SEEN_IN_BIND_EXPR_P (*tp) + && !is_global_var (*tp) + && decl_function_context (*tp) == current_function_decl) + return *tp; n = splay_tree_lookup (gimplify_omp_ctxp->variables, (splay_tree_key) *tp); if (n == NULL) diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 5c330f034b2..e4c0ffb799d 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -80,6 +80,7 @@ struct gimplify_omp_ctx; extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); extern bool lhd_omp_mappable_type (tree); +extern bool lhd_omp_scalar_p (tree); extern const char *lhd_get_substring_location (const substring_loc &, location_t *out_loc); @@ -234,6 +235,7 @@ extern tree lhd_make_node (enum tree_code); #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR NULL #define LANG_HOOKS_OMP_CLAUSE_DTOR hook_tree_tree_tree_null #define LANG_HOOKS_OMP_FINISH_CLAUSE lhd_omp_finish_clause +#define LANG_HOOKS_OMP_SCALAR_P lhd_omp_scalar_p #define LANG_HOOKS_DECLS { \ LANG_HOOKS_GLOBAL_BINDINGS_P, \ @@ -257,7 +259,8 @@ extern tree lhd_make_node (enum tree_code); LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP, \ LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR, \ LANG_HOOKS_OMP_CLAUSE_DTOR, \ - LANG_HOOKS_OMP_FINISH_CLAUSE \ + LANG_HOOKS_OMP_FINISH_CLAUSE, \ + LANG_HOOKS_OMP_SCALAR_P \ } /* LTO hooks. */ diff --git a/gcc/langhooks.c b/gcc/langhooks.c index 6483dc1c6d6..1ce19628b2a 100644 --- a/gcc/langhooks.c +++ b/gcc/langhooks.c @@ -507,6 +507,24 @@ lhd_omp_finish_clause (tree, gimple_seq *) { } +/* Return true if DECL is a scalar variable (for the purpose of + implicit firstprivatization). */ + +bool +lhd_omp_scalar_p (tree decl) +{ + tree type = TREE_TYPE (decl); + if (TREE_CODE (type) == REFERENCE_TYPE) + type = TREE_TYPE (type); + if (TREE_CODE (type) == COMPLEX_TYPE) + type = TREE_TYPE (type); + if (INTEGRAL_TYPE_P (type) + || SCALAR_FLOAT_TYPE_P (type) + || TREE_CODE (type) == POINTER_TYPE) + return true; + return false; +} + /* Register language specific type size variables as potentially OpenMP firstprivate variables. */ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index 150227c88d0..4e925ad6902 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -261,6 +261,10 @@ struct lang_hooks_for_decls /* Do language specific checking on an implicitly determined clause. */ void (*omp_finish_clause) (tree clause, gimple_seq *pre_p); + + /* Return true if DECL is a scalar variable (for the purpose of + implicit firstprivatization). */ + bool (*omp_scalar_p) (tree decl); }; /* Language hooks related to LTO serialization. */ diff --git a/gcc/omp-low.c b/gcc/omp-low.c index e5b9e4c1091..331da6a1bef 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -8010,12 +8010,27 @@ expand_omp_ordered_sink (gimple_stmt_iterator *gsi, struct omp_for_data *fd, for (i = 0; i < fd->ordered; i++) { + tree step = NULL_TREE; off = TREE_PURPOSE (deps); + if (TREE_CODE (off) == TRUNC_DIV_EXPR) + { + step = TREE_OPERAND (off, 1); + off = TREE_OPERAND (off, 0); + } if (!integer_zerop (off)) { gcc_assert (fd->loops[i].cond_code == LT_EXPR || fd->loops[i].cond_code == GT_EXPR); bool forward = fd->loops[i].cond_code == LT_EXPR; + if (step) + { + /* Non-simple Fortran DO loops. If step is variable, + we don't know at compile even the direction, so can't + warn. */ + if (TREE_CODE (step) != INTEGER_CST) + break; + forward = tree_int_cst_sgn (step) != -1; + } if (forward ^ OMP_CLAUSE_DEPEND_SINK_NEGATIVE (deps)) warning_at (loc, 0, "%<depend(sink)%> clause waiting for " "lexically later iteration"); @@ -8036,16 +8051,33 @@ expand_omp_ordered_sink (gimple_stmt_iterator *gsi, struct omp_for_data *fd, edge e1 = split_block (gsi_bb (gsi2), gsi_stmt (gsi2)); edge e2 = split_block_after_labels (e1->dest); - *gsi = gsi_after_labels (e1->dest); + gsi2 = gsi_after_labels (e1->dest); + *gsi = gsi_last_bb (e1->src); for (i = 0; i < fd->ordered; i++) { tree itype = TREE_TYPE (fd->loops[i].v); + tree step = NULL_TREE; + tree orig_off = NULL_TREE; if (POINTER_TYPE_P (itype)) itype = sizetype; if (i) deps = TREE_CHAIN (deps); off = TREE_PURPOSE (deps); - tree s = fold_convert_loc (loc, itype, fd->loops[i].step); + if (TREE_CODE (off) == TRUNC_DIV_EXPR) + { + step = TREE_OPERAND (off, 1); + off = TREE_OPERAND (off, 0); + gcc_assert (fd->loops[i].cond_code == LT_EXPR + && integer_onep (fd->loops[i].step) + && !POINTER_TYPE_P (TREE_TYPE (fd->loops[i].v))); + } + tree s = fold_convert_loc (loc, itype, step ? step : fd->loops[i].step); + if (step) + { + off = fold_convert_loc (loc, itype, off); + orig_off = off; + off = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype, off, s); + } if (integer_zerop (off)) t = boolean_true_node; @@ -8067,7 +8099,36 @@ expand_omp_ordered_sink (gimple_stmt_iterator *gsi, struct omp_for_data *fd, else a = fold_build2_loc (loc, PLUS_EXPR, TREE_TYPE (fd->loops[i].v), fd->loops[i].v, co); - if (fd->loops[i].cond_code == LT_EXPR) + if (step) + { + tree t1, t2; + if (OMP_CLAUSE_DEPEND_SINK_NEGATIVE (deps)) + t1 = fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, + fd->loops[i].n1); + else + t1 = fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, + fd->loops[i].n2); + if (OMP_CLAUSE_DEPEND_SINK_NEGATIVE (deps)) + t2 = fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, + fd->loops[i].n2); + else + t2 = fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, + fd->loops[i].n1); + t = fold_build2_loc (loc, LT_EXPR, boolean_type_node, + step, build_int_cst (TREE_TYPE (step), 0)); + if (TREE_CODE (step) != INTEGER_CST) + { + t1 = unshare_expr (t1); + t1 = force_gimple_operand_gsi (gsi, t1, true, NULL_TREE, + false, GSI_CONTINUE_LINKING); + t2 = unshare_expr (t2); + t2 = force_gimple_operand_gsi (gsi, t2, true, NULL_TREE, + false, GSI_CONTINUE_LINKING); + } + t = fold_build3_loc (loc, COND_EXPR, boolean_type_node, + t, t2, t1); + } + else if (fd->loops[i].cond_code == LT_EXPR) { if (OMP_CLAUSE_DEPEND_SINK_NEGATIVE (deps)) t = fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, @@ -8090,16 +8151,20 @@ expand_omp_ordered_sink (gimple_stmt_iterator *gsi, struct omp_for_data *fd, off = fold_convert_loc (loc, itype, off); - if (fd->loops[i].cond_code == LT_EXPR - ? !integer_onep (fd->loops[i].step) - : !integer_minus_onep (fd->loops[i].step)) + if (step + || (fd->loops[i].cond_code == LT_EXPR + ? !integer_onep (fd->loops[i].step) + : !integer_minus_onep (fd->loops[i].step))) { - if (TYPE_UNSIGNED (itype) && fd->loops[i].cond_code == GT_EXPR) + if (step == NULL_TREE + && TYPE_UNSIGNED (itype) + && fd->loops[i].cond_code == GT_EXPR) t = fold_build2_loc (loc, TRUNC_MOD_EXPR, itype, off, fold_build1_loc (loc, NEGATE_EXPR, itype, s)); else - t = fold_build2_loc (loc, TRUNC_MOD_EXPR, itype, off, s); + t = fold_build2_loc (loc, TRUNC_MOD_EXPR, itype, + orig_off ? orig_off : off, s); t = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, t, build_int_cst (itype, 0)); if (integer_zerop (t) && !warned_step) @@ -8122,7 +8187,9 @@ expand_omp_ordered_sink (gimple_stmt_iterator *gsi, struct omp_for_data *fd, fd->loops[i].v, fd->loops[i].n1); t = fold_convert_loc (loc, fd->iter_type, t); } - if (TYPE_UNSIGNED (itype) && fd->loops[i].cond_code == GT_EXPR) + if (step) + /* We have divided off by step already earlier. */; + else if (TYPE_UNSIGNED (itype) && fd->loops[i].cond_code == GT_EXPR) off = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype, off, fold_build1_loc (loc, NEGATE_EXPR, itype, s)); @@ -8145,15 +8212,14 @@ expand_omp_ordered_sink (gimple_stmt_iterator *gsi, struct omp_for_data *fd, } off = unshare_expr (off); t = fold_build2_loc (loc, PLUS_EXPR, fd->iter_type, t, off); - t = force_gimple_operand_gsi (gsi, t, true, NULL_TREE, + t = force_gimple_operand_gsi (&gsi2, t, true, NULL_TREE, true, GSI_SAME_STMT); args.safe_push (t); } gimple *g = gimple_build_call_vec (builtin_decl_explicit (sink_ix), args); gimple_set_location (g, loc); - gsi_insert_before (gsi, g, GSI_SAME_STMT); + gsi_insert_before (&gsi2, g, GSI_SAME_STMT); - *gsi = gsi_last_bb (e1->src); cond = unshare_expr (cond); cond = force_gimple_operand_gsi (gsi, cond, true, NULL_TREE, false, GSI_CONTINUE_LINKING); @@ -16339,7 +16405,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) } if (tkind == GOMP_MAP_FIRSTPRIVATE_INT) s = size_int (0); - else if (is_reference (var)) + else if (is_reference (ovar)) s = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (ovar))); else s = TYPE_SIZE_UNIT (TREE_TYPE (ovar)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 595021f3274..03dcd5b6515 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2016-11-10 Jakub Jelinek <jakub@redhat.com> + + * gfortran.dg/gomp/pr77516.f90: Add dg-warning. + * gfortran.dg/gomp/target1.f90: Remove ordered clause where it is + no longer allowed and corresponding ordered construct. + * gfortran.dg/gomp/linear-1.f90: New test. + * gfortran.dg/gomp/declare-simd-2.f90: New test. + * gfortran.dg/gomp/declare-target-1.f90: New test. + * gfortran.dg/gomp/declare-target-2.f90: New test. + 2016-11-10 Martin Liska <mliska@suse.cz> PR sanitizer/78270 @@ -7,7 +17,7 @@ Jakub Jelinek <jakub@redhat.com> PR debug/78112 - * g++.dg/pr78112.C: New testcase + * g++.dg/pr78112.C: New testcase. 2016-11-09 Jakub Jelinek <jakub@redhat.com> diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-simd-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-simd-2.f90 new file mode 100644 index 00000000000..8f76774fd6e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-simd-2.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } + +function f1 (a, b, c, d, e, f) + integer, value :: a, b, c + integer :: d, e, f, f1 +!$omp declare simd (f1) uniform(b) linear(c, d) linear(uval(e)) linear(ref(f)) + a = a + 1 + b = b + 1 + c = c + 1 + d = d + 1 + e = e + 1 + f = f + 1 + f1 = a + b + c + d + e + f +end function f1 +integer function f2 (a, b) + integer :: a, b +!$omp declare simd uniform(b) linear(ref(a):b) + a = a + 1 + f2 = a + b +end function f2 diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-1.f90 new file mode 100644 index 00000000000..bf64e72d082 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-1.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } + +module declare_target_1 + !$omp declare target to (var_1, var_4) link (var_2, var_3) & + !$omp & link (var_5) to (var_6) + integer :: var_1, var_2, var_3, var_4, var_5, var_6 + interface + subroutine foo + !$omp declare target + end subroutine + end interface +end +subroutine bar + !$omp declare target + integer, save :: var_9 + !$omp declare target link (var_8) to (baz, var_7) link (var_9) to (var_10) + integer, save :: var_7, var_8, var_10 + integer :: var_11, var_12, var_13, var_14 + common /c1/ var_11, var_12 + common /c2/ var_13 + common /c3/ var_14 + !$omp declare target (baz, var_7, var_10, /c1/) + !$omp declare target to (/c2/) + !$omp declare target link (/c3/) + !$omp declare target (bar) + call baz +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 new file mode 100644 index 00000000000..2217eab07e5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 @@ -0,0 +1,51 @@ +! { dg-do compile } + +module declare_target_2 + !$omp declare target to (a) link (a) ! { dg-error "TO clause and later in LINK" } + !$omp declare target (b) + !$omp declare target link (b) ! { dg-error "TO clause and later in LINK" } + !$omp declare target link (f) + !$omp declare target to (f) ! { dg-error "LINK clause and later in TO" } + !$omp declare target(c, c) ! { dg-error "mentioned multiple times in clauses of the same" } + !$omp declare target to (d) to (d) ! { dg-error "mentioned multiple times in clauses of the same" } + !$omp declare target link (e, e) ! { dg-error "mentioned multiple times in clauses of the same" } + integer, save :: a, b, c, d, e, f + interface + integer function f1 (a) + !$omp declare target (f1) ! { dg-error "form without clauses is allowed in interface block" } + integer :: a + end function + end interface + interface + integer function f2 (a) + !$omp declare target to (f2) ! { dg-error "form without clauses is allowed in interface block" } + integer :: a + end function + end interface +end +subroutine bar + !$omp declare target link (baz) ! { dg-error "isn.t SAVEd" } + call baz ! { dg-error "attribute conflicts" } +end subroutine +subroutine foo ! { dg-error "attribute conflicts" } + integer :: g, h, i, j, k, l, m, n, o, p, q + common /c1/ g, h + common /c2/ i, j + common /c3/ k, l + common /c4/ m, n + common /c5/ o, p, q + !$omp declare target to (g) ! { dg-error "is an element of a COMMON block" } + !$omp declare target link (foo) + !$omp declare target to (/c2/) + !$omp declare target (/c2/) + !$omp declare target to(/c2/) + !$omp declare target link(/c2/) ! { dg-error "TO clause and later in LINK" } + !$omp declare target link(/c3/) + !$omp declare target (/c3/) ! { dg-error "LINK clause and later in TO" } + !$omp declare target (/c4/, /c4/) ! { dg-error "mentioned multiple times in clauses of the same" } + !$omp declare target to (/c4/) to(/c4/) ! { dg-error "mentioned multiple times in clauses of the same" } + !$omp declare target link (/c5/) + !$omp declare target link (/c5/) + !$omp declare target link(/c5/)link(/c5/) ! { dg-error "mentioned multiple times in clauses of the same" } + !$omp declare target link(/c5/,/c5/) ! { dg-error "mentioned multiple times in clauses of the same" } +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/linear-1.f90 b/gcc/testsuite/gfortran.dg/gomp/linear-1.f90 new file mode 100644 index 00000000000..0d7eb8e3f8f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/linear-1.f90 @@ -0,0 +1,58 @@ +subroutine foo (x, y) + integer :: i, x, y + common /i/ i + interface + function bar (x, y) + integer :: x, y, bar + !$omp declare simd (bar) linear (ref (x) : 1) linear (uval (y)) + end function bar + end interface + !$omp simd linear (x : y + 1) + do i = 1, 10 + x = x + y + 1 + end do + !$omp simd linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do + !$omp simd linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do + !$omp simd linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do + !$omp do linear (x : y + 1) + do i = 1, 10 + x = x + y + 1 + end do + !$omp do linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do + !$omp do linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do + !$omp do linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do + !$omp do simd linear (x : y + 1) + do i = 1, 10 + x = x + y + 1 + end do + !$omp do simd linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do + !$omp do simd linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do + !$omp do simd linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" } + do i = 1, 10 + x = x + y + 1 + end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 b/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 index 7852abf8bcf..9c0a95b9f79 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 @@ -4,7 +4,7 @@ program pr77516 integer :: i, x x = 0 -!$omp simd safelen(0) reduction(+:x) +!$omp simd safelen(0) reduction(+:x) ! { dg-warning "must be positive" } do i = 1, 8 x = x + 1 end do diff --git a/gcc/testsuite/gfortran.dg/gomp/target1.f90 b/gcc/testsuite/gfortran.dg/gomp/target1.f90 index 1e771763cda..da930b92422 100644 --- a/gcc/testsuite/gfortran.dg/gomp/target1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/target1.f90 @@ -51,15 +51,12 @@ contains !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & - !$omp & ordered schedule (static, 8) + !$omp & schedule (static, 8) do i = 1, 10 do j = 1, 10 r = r + 1 p = q call dosomething (a, n, p + q) - !$omp ordered - p = q - !$omp end ordered s = i * 10 + j end do end do @@ -67,16 +64,13 @@ contains !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & - !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) do i = 1, 10 do j = 1, 10 r = r + 1 p = q call dosomething (a, n, p + q) end do - !$omp ordered - p = q - !$omp end ordered s = i * 10 end do !$omp end target teams distribute parallel do @@ -167,7 +161,7 @@ contains !$omp end target !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) !$omp teams distribute parallel do num_teams (n + 4) & - !$omp & if (n .ne. 6) default(shared) ordered schedule (static, 8) & + !$omp & if (n .ne. 6) default(shared) schedule (static, 8) & !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) @@ -176,9 +170,6 @@ contains r = r + 1 p = q call dosomething (a, n, p + q) - !$omp ordered - p = q - !$omp end ordered s = i * 10 + j end do end do @@ -187,16 +178,13 @@ contains !$omp teams distribute parallel do num_teams (n + 4)if(n.ne.6)default(shared)& !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & - !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) do i = 1, 10 do j = 1, 10 r = r + 1 p = q call dosomething (a, n, p + q) end do - !$omp ordered - p = q - !$omp end ordered s = i * 10 end do !$omp end teams distribute parallel do @@ -285,7 +273,7 @@ contains !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & !$omp & default(shared) shared(n) private (p) reduction(+:r) !$omp distribute parallel do if (n .ne. 6) default(shared) & - !$omp & ordered schedule (static, 8) private (p) firstprivate (q) & + !$omp & schedule (static, 8) private (p) firstprivate (q) & !$omp & shared(n)reduction(+:r)dist_schedule(static,4)collapse(2)& !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) do i = 1, 10 @@ -293,9 +281,6 @@ contains r = r + 1 p = q call dosomething (a, n, p + q) - !$omp ordered - p = q - !$omp end ordered s = i * 10 + j end do end do @@ -306,16 +291,13 @@ contains !$omp distribute parallel do if(n.ne.6)default(shared)& !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & !$omp & dist_schedule (static, 4) num_threads (n + 4) & - !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) do i = 1, 10 do j = 1, 10 r = r + 1 p = q call dosomething (a, n, p + q) end do - !$omp ordered - p = q - !$omp end ordered s = i * 10 end do !$omp end distribute parallel do @@ -418,7 +400,7 @@ contains !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & !$omp & default(shared) shared(n) private (p) reduction(+:r) !$omp distribute parallel do if (n .ne. 6) default(shared) & - !$omp & ordered schedule (static, 8) private (p) firstprivate (q) & + !$omp & schedule (static, 8) private (p) firstprivate (q) & !$omp & shared(n)reduction(+:r)dist_schedule(static,4)collapse(2)& !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) do i = 1, 10 @@ -426,9 +408,6 @@ contains r = r + 1 p = q call dosomething (a, n, p + q) - !$omp ordered - p = q - !$omp end ordered s = i * 10 + j end do end do @@ -439,16 +418,13 @@ contains !$omp distribute parallel do if(n.ne.6)default(shared)& !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & !$omp & dist_schedule (static, 4) num_threads (n + 4) & - !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) do i = 1, 10 do j = 1, 10 r = r + 1 p = q call dosomething (a, n, p + q) end do - !$omp ordered - p = q - !$omp end ordered s = i * 10 end do !$omp end distribute parallel do diff --git a/gcc/varpool.c b/gcc/varpool.c index 78969d28c1c..71fb4b88df1 100644 --- a/gcc/varpool.c +++ b/gcc/varpool.c @@ -149,11 +149,11 @@ varpool_node::get_create (tree decl) node = varpool_node::create_empty (); node->decl = decl; - if ((flag_openacc || flag_openmp) && !DECL_EXTERNAL (decl) + if ((flag_openacc || flag_openmp) && lookup_attribute ("omp declare target", DECL_ATTRIBUTES (decl))) { node->offloadable = 1; - if (ENABLE_OFFLOADING) + if (ENABLE_OFFLOADING && !DECL_EXTERNAL (decl)) { g->have_offload = true; if (!in_lto_p) |