+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
+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>
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)
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);
static void
show_omp_clauses (gfc_omp_clauses *omp_clauses)
{
- int list_type;
+ int list_type, i;
switch (omp_clauses->cancel)
{
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);
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)
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 ();
}
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);
}
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
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;
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;
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 ();
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)
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)
{
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);
}
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:
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;
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 }
#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
#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
/* 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:
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++)
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
/* 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;
{
OMP_DEPEND_IN,
OMP_DEPEND_OUT,
- OMP_DEPEND_INOUT
+ OMP_DEPEND_INOUT,
+ OMP_DEPEND_SINK_FIRST,
+ OMP_DEPEND_SINK
};
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
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;
OMP_LIST_LINK,
OMP_LIST_USE_DEVICE,
OMP_LIST_CACHE,
+ OMP_LIST_IS_DEVICE_PTR,
+ OMP_LIST_USE_DEVICE_PTR,
OMP_LIST_NUM
};
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;
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;
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;
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;
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
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 *);
|| 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");
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);
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);
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);
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);
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[] =
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)
};
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 ();
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;
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);
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);
}
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)
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. */
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)
{
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)
{
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)
{
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;
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))
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],
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
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)
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);
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,
}
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
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)
&& !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;
&& 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],
&& 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)
&& 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)
&& 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)
&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
#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)
#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)
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];
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;
}
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)));
}
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)));
}
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);
}
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)
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,
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:
cleanup:
gfc_current_locus = old_loc;
+ if (c)
+ gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
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);
}
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);
}
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)));
}
(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)));
}
}
+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)
{
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)));
}
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)));
}
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));
}
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;
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;
}
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
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;
|| 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;
&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;
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)
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)
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)
{
}
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;
"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
}
}
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;
"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);
+ }
}
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;
{
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:
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";
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;
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)
}
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);
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:
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:
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)
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,
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);
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);
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,
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);
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);
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: \
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: \
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;
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;
p = "!$OMP MASTER";
break;
case ST_OMP_ORDERED:
+ case ST_OMP_ORDERED_DEPEND:
p = "!$OMP ORDERED";
break;
case ST_OMP_PARALLEL:
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;
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;
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;
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;
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]
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:
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:
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_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_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:
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:
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_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_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:
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:
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;
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:
*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";
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);
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);
conf (dummy, result);
conf (entry, result);
conf (generic, result);
+ conf (generic, omp_declare_target);
+ conf (generic, omp_declare_target_link);
conf (function, subroutine);
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);
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)
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);
if (!attr->proc_pointer)
conf2 (in_common);
+ conf2 (omp_declare_target_link);
+
switch (attr->proc)
{
case PROC_ST_FUNCTION:
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);
}
+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)
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;
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));
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);
}
+/* 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
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;
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
{
tree alignment_var;
- if (block == NULL)
+ if (declare_simd)
alignment_var = gfc_conv_constant_to_tree (n->expr);
else
{
{
gfc_expr *last_step_expr = NULL;
tree last_step = NULL_TREE;
+ bool last_step_parm = false;
for (; n != NULL; n = n->next)
{
{
last_step_expr = n->expr;
last_step = NULL_TREE;
+ last_step_parm = false;
}
if (n->sym->attr.referenced || declare_simd)
{
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);
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);
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;
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;
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)
{
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);
}
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);
}
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)
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);
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);
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;
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;
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)
{
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++)
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
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))
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 ();
}
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);
}
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
GFC_OMP_SPLIT_DISTRIBUTE,
GFC_OMP_SPLIT_TEAMS,
GFC_OMP_SPLIT_TARGET,
+ GFC_OMP_SPLIT_TASKLOOP,
GFC_OMP_SPLIT_NUM
};
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
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;
| 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;
/* 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)
{
= 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
= 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
{
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];
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];
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))
}
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);
}
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:
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);
}
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);
}
return gfc_finish_block (&block);
}
+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)
{
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:
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:
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:
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:
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_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:
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);
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
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
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 ())
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
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);
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 "
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)
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,
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),
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;
{
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)
|| 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)
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);
#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, \
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. */
{
}
+/* 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. */
/* 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. */
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");
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;
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,
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)
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));
}
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);
}
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));
+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
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>
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+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
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
!$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
!$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
!$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)
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
!$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
!$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
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
!$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
!$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
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
!$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
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)
+2016-11-10 Jakub Jelinek <jakub@redhat.com>
+
+ * testsuite/libgomp.fortran/examples-4/declare_target-1.f90
+ (fib_wrapper): Add map(from: x) clause.
+ * testsuite/libgomp.fortran/examples-4/declare_target-2.f90
+ (e_53_2): Likewise.
+ * testsuite/libgomp.fortran/examples-4/declare_target-4.f90
+ (accum): Add map(tmp) clause.
+ * testsuite/libgomp.fortran/examples-4/declare_target-5.f90
+ (accum): Add map(tofrom: tmp) clause.
+ * testsuite/libgomp.fortran/examples-4/target_data-3.f90
+ (gramSchmidt): Likewise.
+ * testsuite/libgomp.fortran/examples-4/teams-2.f90 (dotprod): Add
+ map(tofrom: sum) clause.
+ * testsuite/libgomp.fortran/nestedfn5.f90 (foo): Add twice
+ map (alloc: a, l) clause. Add defaultmap(tofrom: scalar) clause.
+ * testsuite/libgomp.fortran/pr66199-2.f90: Adjust for linear clause
+ only allowed on the loop iterator.
+ * testsuite/libgomp.fortran/target4.f90 (foo): Add map(t) clause.
+ * testsuite/libgomp.fortran/taskloop2.f90: New test.
+ * testsuite/libgomp.fortran/taskloop4.f90: New test.
+ * testsuite/libgomp.fortran/doacross1.f90: New test.
+ * testsuite/libgomp.fortran/doacross3.f90: New test.
+ * testsuite/libgomp.fortran/taskloop1.f90: New test.
+ * testsuite/libgomp.fortran/taskloop3.f90: New test.
+ * testsuite/libgomp.fortran/doacross2.f90: New test.
+ * testsuite/libgomp.c/doacross-1.c (main): Add missing
+ #pragma omp atomic read.
+ * testsuite/libgomp.c/doacross-2.c (main): Likewise.
+ * testsuite/libgomp.c/doacross-3.c (main): Likewise.
+
2016-11-02 Cesar Philippidis <cesar@codesourcery.com>
Nathan Sidwell <nathan@acm.org>
depend(sink: i - 1, j - 2, k - 2 E(m))
if (k <= 4)
{
+ #pragma omp atomic read
l = c[i][j][k + 2];
if (l < 2)
abort ();
c[i][j][k] = 2;
if (i >= 2 && j < 7 && k >= 4)
{
+ #pragma omp atomic read
l = c[i - 2][j + 1][k - 4];
if (l < 2)
abort ();
}
if (i >= 1 && j >= 4 && k >= 2)
{
+ #pragma omp atomic read
l = c[i - 1][j - 2][k - 2];
if (l < 2)
abort ();
depend(sink: i - 1, j - 2, k - 2 E(m))
if (k <= 4)
{
+ #pragma omp atomic read
l = c[i][j][k + 2];
if (l < 2)
abort ();
c[i][j][k] = 2;
if (i >= 4 && j < 7 && k >= 4)
{
+ #pragma omp atomic read
l = c[i - 2][j + 1][k - 4];
if (l < 2)
abort ();
}
if (i >= 3 && j >= 4 && k >= 2)
{
+ #pragma omp atomic read
l = c[i - 1][j - 2][k - 2];
if (l < 2)
abort ();
depend(sink: i - 1, j - 2, k - 2 E(m))
if (k <= 4)
{
+ #pragma omp atomic read
l = c[i][j][k + 2];
if (l < 2)
abort ();
c[i][j][k] = 2;
if (i >= 4 && j < 7 && k >= 4)
{
+ #pragma omp atomic read
l = c[i - 2][j + 1][k - 4];
if (l < 2)
abort ();
}
if (i >= 3 && j >= 4 && k >= 2)
{
+ #pragma omp atomic read
l = c[i - 1][j - 2][k - 2];
if (l < 2)
abort ();
--- /dev/null
+! { dg-do run }
+
+ integer, parameter :: N = 256
+ integer, save :: a(N), b(N / 16, 8, 4), c(N / 32, 8, 8)
+ integer, save, volatile :: d, e
+ integer :: i, j, k, l, m
+ integer :: m1, m2, m3, m4, m5, m6, m7, m8
+ integer :: m9, m10, m11, m12, m13, m14, m15, m16
+ d = 0
+ e = 0
+ !$omp parallel private (l) shared(k)
+ !$omp do schedule(static, 1) ordered(1)
+ do i = 1, N
+ !$omp atomic write
+ a(i) = 1
+ !$omp ordered depend ( sink : i - 1 )
+ if (i.gt.1) then
+ !$omp atomic read
+ l = a(i - 1)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ a(i) = 2
+ if (i.lt.N) then
+ !$omp atomic read
+ l = a(i + 1)
+ if (l.eq.3) call abort
+ end if
+ !$omp ordered depend(source)
+ !$omp atomic write
+ a(i) = 3
+ end do
+ !$omp end do nowait
+ !$omp do schedule(static) ordered ( 3 )
+ do i = 3, N / 16 - 1
+ do j = 1, 8, 2
+ do k = 2, 4
+ !$omp atomic write
+ b(i, j, k) = 1
+ !$omp ordered depend(sink:i,j-2,k-1) &
+ !$omp& depend(sink: i - 2, j - 2, k + 1)
+ !$omp ordered depend(sink:i-3,j+2,k-2)
+ if (j.gt.2.and.k.gt.2) then
+ !$omp atomic read
+ l = b(i,j-2,k-1)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ b(i,j,k) = 2
+ if (i.gt.4.and.j.gt.2.and.k.lt.4) then
+ !$omp atomic read
+ l = b(i-2,j-2, k+1)
+ if (l.lt.2) call abort
+ end if
+ if (i.gt.5.and.j.le.N/16-3.and.k.eq.4) then
+ !$omp atomic read
+ l = b( i - 3, j+2, k-2)
+ if (l.lt.2) call abort
+ end if
+ !$omp ordered depend(source)
+ !$omp atomic write
+ b(i, j, k) = 3
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do schedule(dynamic, 15) collapse(2) ordered(13)
+ do i = 1, N / 32
+ do j = 8, 3, -1
+ do k = 7, 1, -2
+ do m1 = 4, 4
+ do m2 = 4, 4
+ do m3 = 4, 4
+ do m4 = 4, 4
+ do m5 = 4, 4
+ do m6 = 4, 4
+ do m7 = 4, 4
+ do m8 = 4, 4
+ do m9 = 4, 4
+ do m10 = 4, 4
+ do m11 = 4, 4
+ do m12 = 4, 4
+ do m13 = 4, 4
+ do m14 = 4, 4
+ do m15 = 4, 4
+ do m16 = 4, 4
+ !$omp atomic write
+ c(i, j, k) = 1
+ !$omp ordered depend(sink: i, j, k + 2, m1, m2, m3, m4, &
+ !$omp & m5, m6, m7, m8, m9, m10) &
+ !$omp depend(sink: i - 2, j + 1, k - 4, m1,m2,m3,m4,m5, &
+ !$omp & m6,m7,m8,m9,m10) depend ( sink : i-1,j-2,k-2, &
+ !$omp& m1,m2,m3,m4 , m5, m6,m7,m8,m9,m10 )
+ if (k.le.5) then
+ !$omp atomic read
+ l = c(i, j, k + 2)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ c(i, j, k) = 2
+ if (i.ge.3.and.j.lt.8.and.k.ge.5) then
+ !$omp atomic read
+ l = c(i - 2, j + 1, k - 4)
+ if (l.lt.2) call abort
+ end if
+ if (i.ge.2.and.j.ge.5.and.k.ge.3) then
+ !$omp atomic read
+ l = c(i - 1, j - 2, k - 2)
+ if (l.lt.2) call abort
+ end if
+ !$omp ordered depend ( source )
+ !$omp atomic write
+ c(i,j,k)=3
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+ do i = 0, d
+ do j = d + 1, 0, -1
+ do k = 0, d - 1
+ do l = 0, d + 1
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i-2,j+2,k-2,l)
+ if (e.eq.0) call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp single
+ if (i.ne.1.or.j.ne.-1.or.k.ne.0) call abort
+ i = 8; j = 9; k = 10
+ !$omp end single
+ !$omp do ordered(4) collapse(2) lastprivate (i, j, k, m)
+ do i = 0, d
+ do j = d + 1, 0, -1
+ do k = 0, d + 1
+ do m = 0, d-1
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i - 2, j + 2, k - 2, m)
+ call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp single
+ if (i.ne.1.or.j.ne.-1.or.k.ne.2.or.m.ne.0) call abort
+ !$omp end single
+ !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+ do i = 0, d
+ do j = d, 1, -1
+ do k = 0, d + 1
+ do l = 0, d + 3
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i-2,j+2,k-2,l)
+ if (e.eq.0) call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do
+ do i = 1, N
+ if (a(i) .ne. 3) call abort
+ end do
+ !$omp end do nowait
+ !$omp do collapse(2) private(k)
+ do i = 1, N / 16
+ do j = 1, 8
+ do k = 1, 4
+ if (i.ge.3.and.i.lt.N/16.and.iand(j,1).ne.0.and.k.ge.2) then
+ if (b(i,j,k).ne.3) call abort
+ else
+ if (b(i,j,k).ne.0) call abort
+ end if
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do collapse(3)
+ do i = 1, N / 32
+ do j = 1, 8
+ do k = 1, 4
+ if (j.ge.3.and.iand(k,1).ne.0) then
+ if (c(i,j,k).ne.3) call abort
+ else
+ if (c(i,j,k).ne.0) call abort
+ end if
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp end parallel
+end
--- /dev/null
+! { dg-do run }
+
+ integer, parameter :: N = 256
+ integer, save :: a(N), b(N / 16, 8, 4), c(N / 32, 8, 8), g(N/16,8,6)
+ integer, save, volatile :: d, e
+ integer(kind=8), save, volatile :: f
+ integer(kind=8) :: i
+ integer :: j, k, l, m
+ integer :: m1, m2, m3, m4, m5, m6, m7, m8
+ integer :: m9, m10, m11, m12, m13, m14, m15, m16
+ d = 0
+ e = 0
+ f = 0
+ !$omp parallel private (l) shared(k)
+ !$omp do schedule(static, 1) ordered(1)
+ do i = 2, N + f
+ !$omp atomic write
+ a(i) = 1
+ !$omp ordered depend ( sink : i - 1 )
+ if (i.gt.2) then
+ !$omp atomic read
+ l = a(i - 1)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ a(i) = 2
+ if (i.lt.N) then
+ !$omp atomic read
+ l = a(i + 1)
+ if (l.eq.3) call abort
+ end if
+ !$omp ordered depend(source)
+ !$omp atomic write
+ a(i) = 3
+ end do
+ !$omp end do nowait
+ !$omp do schedule(static) ordered ( 3 )
+ do i = 4, N / 16 - 1 + f
+ do j = 1, 8, 2
+ do k = 2, 4
+ !$omp atomic write
+ b(i, j, k) = 1
+ !$omp ordered depend(sink:i,j-2,k-1) &
+ !$omp& depend(sink: i - 2, j - 2, k + 1)
+ !$omp ordered depend(sink:i-3,j+2,k-2)
+ if (j.gt.2.and.k.gt.2) then
+ !$omp atomic read
+ l = b(i,j-2,k-1)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ b(i,j,k) = 2
+ if (i.gt.5.and.j.gt.2.and.k.lt.4) then
+ !$omp atomic read
+ l = b(i-2,j-2, k+1)
+ if (l.lt.2) call abort
+ end if
+ if (i.gt.6.and.j.le.N/16-3.and.k.eq.4) then
+ !$omp atomic read
+ l = b( i - 3, j+2, k-2)
+ if (l.lt.2) call abort
+ end if
+ !$omp ordered depend(source)
+ !$omp atomic write
+ b(i, j, k) = 3
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do schedule(dynamic, 15) collapse(2) ordered(13)
+ do i = 3, N / 32 + f
+ do j = 8, 3, -1
+ do k = 7, 1, -2
+ do m1 = 4, 4
+ do m2 = 4, 4
+ do m3 = 4, 4
+ do m4 = 4, 4
+ do m5 = 4, 4
+ do m6 = 4, 4
+ do m7 = 4, 4
+ do m8 = 4, 4
+ do m9 = 4, 4
+ do m10 = 4, 4
+ do m11 = 4, 4
+ do m12 = 4, 4
+ do m13 = 4, 4
+ do m14 = 4, 4
+ do m15 = 4, 4
+ do m16 = 4, 4
+ !$omp atomic write
+ c(i, j, k) = 1
+ !$omp ordered depend(sink: i, j, k + 2, m1, m2, m3, m4, &
+ !$omp & m5, m6, m7, m8, m9, m10) &
+ !$omp depend(sink: i - 2, j + 1, k - 4, m1,m2,m3,m4,m5, &
+ !$omp & m6,m7,m8,m9,m10) depend ( sink : i-1,j-2,k-2, &
+ !$omp& m1,m2,m3,m4 , m5, m6,m7,m8,m9,m10 )
+ if (k.le.5) then
+ !$omp atomic read
+ l = c(i, j, k + 2)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ c(i, j, k) = 2
+ if (i.ge.5.and.j.lt.8.and.k.ge.5) then
+ !$omp atomic read
+ l = c(i - 2, j + 1, k - 4)
+ if (l.lt.2) call abort
+ end if
+ if (i.ge.4.and.j.ge.5.and.k.ge.3) then
+ !$omp atomic read
+ l = c(i - 1, j - 2, k - 2)
+ if (l.lt.2) call abort
+ end if
+ !$omp ordered depend ( source )
+ !$omp atomic write
+ c(i,j,k)=3
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ !$omp do schedule(static) ordered(3)
+ do j = 1, N / 16 - 1
+ do k = 1, 7, 2
+ do i = 4, 6 + f
+ !$omp atomic write
+ g(j, k, i) = 1
+ !$omp ordered depend(sink: j, k-2,i-1) &
+ !$omp& depend(sink: j - 2, k - 2, i + 1)
+ !$omp ordered depend(sink:j-3,k+2,i-2)
+ if (k.gt.2.and.i.gt.4) then
+ !$omp atomic read
+ l = g(j,k-2,i-1)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ g(j,k,i) = 2
+ if (j.gt.2.and.k.gt.2.and.i.lt.6) then
+ !$omp atomic read
+ l = g(j-2,k-2, i+1)
+ if (l.lt.2) call abort
+ end if
+ if (j.gt.3.and.k.le.N/16-3.and.i.eq.6) then
+ !$omp atomic read
+ l = g( j - 3, k+2, i-2)
+ if (l.lt.2) call abort
+ end if
+ !$omp ordered depend(source)
+ !$omp atomic write
+ g(j, k, i) = 3
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+ do i = 2, f + 2
+ do j = d + 1, 0, -1
+ do k = 0, d - 1
+ do l = 0, d + 1
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i-2,j+2,k-2,l)
+ if (e.eq.0) call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp single
+ if (i.ne.3.or.j.ne.-1.or.k.ne.0) call abort
+ i = 8; j = 9; k = 10
+ !$omp end single
+ !$omp do ordered(4) collapse(2) lastprivate (i, j, k, m)
+ do i = 2, f + 2
+ do j = d + 1, 0, -1
+ do k = 0, d + 1
+ do m = 0, d-1
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i - 2, j + 2, k - 2, m)
+ call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp single
+ if (i.ne.3.or.j.ne.-1.or.k.ne.2.or.m.ne.0) call abort
+ !$omp end single
+ !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+ do i = 2, f + 2
+ do j = d, 1, -1
+ do k = 0, d + 1
+ do l = 0, d + 3
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i-2,j+2,k-2,l)
+ if (e.eq.0) call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp single
+ if (a(1) .ne. 0) call abort
+ !$omp end single nowait
+ !$omp do
+ do i = 2, N
+ if (a(i) .ne. 3) call abort
+ end do
+ !$omp end do nowait
+ !$omp do collapse(2) private(k)
+ do i = 1, N / 16
+ do j = 1, 8
+ do k = 1, 4
+ if (i.ge.4.and.i.lt.N/16.and.iand(j,1).ne.0.and.k.ge.2) then
+ if (b(i,j,k).ne.3) call abort
+ else
+ if (b(i,j,k).ne.0) call abort
+ end if
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do collapse(3)
+ do i = 1, N / 32
+ do j = 1, 8
+ do k = 1, 4
+ if (i.ge.3.and.j.ge.3.and.iand(k,1).ne.0) then
+ if (c(i,j,k).ne.3) call abort
+ else
+ if (c(i,j,k).ne.0) call abort
+ end if
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do collapse(2) private(k)
+ do i = 1, N / 16
+ do j = 1, 8
+ do k = 1, 6
+ if (i.lt.N/16.and.iand(j,1).ne.0.and.k.ge.4) then
+ if (g(i,j,k).ne.3) call abort
+ else
+ if (g(i,j,k).ne.0) call abort
+ end if
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp end parallel
+end
--- /dev/null
+! { dg-do run }
+
+ integer, parameter :: N = 256
+ integer, save :: a(N), b(N / 16, 8, 4), c(N / 32, 8, 8), g(N/16,8,6)
+ integer, save, volatile :: d, e
+ integer(kind=8), save, volatile :: f
+ integer(kind=8) :: i
+ integer :: j, k, l, m
+ integer :: m1, m2, m3, m4, m5, m6, m7, m8
+ integer :: m9, m10, m11, m12, m13, m14, m15, m16
+ d = 0
+ e = 0
+ f = 0
+ !$omp parallel private (l) shared(k)
+ !$omp do schedule(guided, 3) ordered(1)
+ do i = 2, N + f, f + 1
+ !$omp atomic write
+ a(i) = 1
+ !$omp ordered depend ( sink : i - 1 )
+ if (i.gt.2) then
+ !$omp atomic read
+ l = a(i - 1)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ a(i) = 2
+ if (i.lt.N) then
+ !$omp atomic read
+ l = a(i + 1)
+ if (l.eq.3) call abort
+ end if
+ !$omp ordered depend(source)
+ !$omp atomic write
+ a(i) = 3
+ end do
+ !$omp end do nowait
+ !$omp do schedule(guided) ordered ( 3 )
+ do i = 4, N / 16 - 1 + f, 1 + f
+ do j = 1, 8, d + 2
+ do k = 2, 4, 1 + d
+ !$omp atomic write
+ b(i, j, k) = 1
+ !$omp ordered depend(sink:i,j-2,k-1) &
+ !$omp& depend(sink: i - 2, j - 2, k + 1)
+ !$omp ordered depend(sink:i-3,j+2,k-2)
+ if (j.gt.2.and.k.gt.2) then
+ !$omp atomic read
+ l = b(i,j-2,k-1)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ b(i,j,k) = 2
+ if (i.gt.5.and.j.gt.2.and.k.lt.4) then
+ !$omp atomic read
+ l = b(i-2,j-2, k+1)
+ if (l.lt.2) call abort
+ end if
+ if (i.gt.6.and.j.le.N/16-3.and.k.eq.4) then
+ !$omp atomic read
+ l = b( i - 3, j+2, k-2)
+ if (l.lt.2) call abort
+ end if
+ !$omp ordered depend(source)
+ !$omp atomic write
+ b(i, j, k) = 3
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do schedule(guided, 15) collapse(2) ordered(13)
+ do i = 3, N / 32 + f, d + 1
+ do j = 8, 3, d - 1
+ do k = 7, 1, d - 2
+ do m1 = 4, 4, d + 1
+ do m2 = 4, 4, 1 + d
+ do m3 = 4, 4, d + 1
+ do m4 = 4, 4, 1 + d
+ do m5 = 4, 4, d + 1
+ do m6 = 4, 4, 1 + d
+ do m7 = 4, 4, d + 1
+ do m8 = 4, 4, 1 + d
+ do m9 = 4, 4
+ do m10 = 4, 4, d + 1
+ do m11 = 4, 4, 1 + d
+ do m12 = 4, 4, d + 1
+ do m13 = 4, 4
+ do m14 = 4, 4, 1 + d
+ do m15 = 4, 4, d + 1
+ do m16 = 4, 4, 1 + d
+ !$omp atomic write
+ c(i, j, k) = 1
+ !$omp ordered depend(sink: i, j, k + 2, m1, m2, m3, m4, &
+ !$omp & m5, m6, m7, m8, m9, m10) &
+ !$omp depend(sink: i - 2, j + 1, k - 4, m1,m2,m3,m4,m5, &
+ !$omp & m6,m7,m8,m9,m10) depend ( sink : i-1,j-2,k-2, &
+ !$omp& m1,m2,m3,m4 , m5, m6,m7,m8,m9,m10 )
+ if (k.le.5) then
+ !$omp atomic read
+ l = c(i, j, k + 2)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ c(i, j, k) = 2
+ if (i.ge.5.and.j.lt.8.and.k.ge.5) then
+ !$omp atomic read
+ l = c(i - 2, j + 1, k - 4)
+ if (l.lt.2) call abort
+ end if
+ if (i.ge.4.and.j.ge.5.and.k.ge.3) then
+ !$omp atomic read
+ l = c(i - 1, j - 2, k - 2)
+ if (l.lt.2) call abort
+ end if
+ !$omp ordered depend ( source )
+ !$omp atomic write
+ c(i,j,k)=3
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ !$omp do schedule(guided, 5) ordered(3)
+ do j = 1, N / 16 - 1, d + 1
+ do k = 1, 7, 2 + d
+ do i = 4, 6 + f, f + 1
+ !$omp atomic write
+ g(j, k, i) = 1
+ !$omp ordered depend(sink: j, k-2,i-1) &
+ !$omp& depend(sink: j - 2, k - 2, i + 1)
+ !$omp ordered depend(sink:j-3,k+2,i-2)
+ if (k.gt.2.and.i.gt.4) then
+ !$omp atomic read
+ l = g(j,k-2,i-1)
+ if (l.lt.2) call abort
+ end if
+ !$omp atomic write
+ g(j,k,i) = 2
+ if (j.gt.2.and.k.gt.2.and.i.lt.6) then
+ !$omp atomic read
+ l = g(j-2,k-2, i+1)
+ if (l.lt.2) call abort
+ end if
+ if (j.gt.3.and.k.le.N/16-3.and.i.eq.6) then
+ !$omp atomic read
+ l = g( j - 3, k+2, i-2)
+ if (l.lt.2) call abort
+ end if
+ !$omp ordered depend(source)
+ !$omp atomic write
+ g(j, k, i) = 3
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+ do i = 2, f + 2, 1 + f
+ do j = d + 1, 0, d - 1
+ do k = 0, d - 1, d + 1
+ do l = 0, d + 1, 1 + d
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i-2,j+2,k-2,l)
+ if (e.eq.0) call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp single
+ if (i.ne.3.or.j.ne.-1.or.k.ne.0) call abort
+ i = 8; j = 9; k = 10
+ !$omp end single
+ !$omp do ordered(4) collapse(2) lastprivate (i, j, k, m)
+ do i = 2, f + 2, 1 + f
+ do j = d + 1, 0, d - 1
+ do k = 0, d + 1, 1 + d
+ do m = 0, d-1, d+1
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i - 2, j + 2, k - 2, m)
+ call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp single
+ if (i.ne.3.or.j.ne.-1.or.k.ne.2.or.m.ne.0) call abort
+ !$omp end single
+ !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+ do i = 2, f + 2, 1 + f
+ do j = d, 1, d -1
+ do k = 0, d + 1, 1 + d
+ do l = 0, d + 3, d + 1
+ !$omp ordered depend(source)
+ !$omp ordered depend(sink: i-2,j+2,k-2,l)
+ if (e.eq.0) call abort
+ end do
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp single
+ if (a(1) .ne. 0) call abort
+ !$omp end single nowait
+ !$omp do
+ do i = 2, N
+ if (a(i) .ne. 3) call abort
+ end do
+ !$omp end do nowait
+ !$omp do collapse(2) private(k)
+ do i = 1, N / 16
+ do j = 1, 8
+ do k = 1, 4
+ if (i.ge.4.and.i.lt.N/16.and.iand(j,1).ne.0.and.k.ge.2) then
+ if (b(i,j,k).ne.3) call abort
+ else
+ if (b(i,j,k).ne.0) call abort
+ end if
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do collapse(3)
+ do i = 1, N / 32
+ do j = 1, 8
+ do k = 1, 4
+ if (i.ge.3.and.j.ge.3.and.iand(k,1).ne.0) then
+ if (c(i,j,k).ne.3) call abort
+ else
+ if (c(i,j,k).ne.0) call abort
+ end if
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp do collapse(2) private(k)
+ do i = 1, N / 16
+ do j = 1, 8
+ do k = 1, 6
+ if (i.lt.N/16.and.iand(j,1).ne.0.and.k.ge.4) then
+ if (g(i,j,k).ne.3) call abort
+ else
+ if (g(i,j,k).ne.0) call abort
+ end if
+ end do
+ end do
+ end do
+ !$omp end do nowait
+ !$omp end parallel
+end
integer function fib_wrapper (n)
integer :: x
- !$omp target map(to: n) if(n > THRESHOLD)
+ !$omp target map(to: n) map(from: x) if(n > THRESHOLD)
x = fib (n)
!$omp end target
fib_wrapper = x
program e_53_2
!$omp declare target (fib)
integer :: x, fib
- !$omp target
+ !$omp target map(from: x)
x = fib (25)
!$omp end target
if (x /= fib (25)) call abort
use e_53_4_mod
integer :: i, k
tmp = 0.0e0
- !$omp target
+ !$omp target map(tmp)
!$omp parallel do reduction(+:tmp)
do i = 1, N
tmp = tmp + Pfun (k, i)
real :: tmp1
integer :: i
tmp = 0.0e0
- !$omp target
+ !$omp target map(tofrom: tmp)
!$omp parallel do private(tmp1) reduction(+:tmp)
do i = 1, N
tmp1 = 0.0e0
!$omp target data map(Q)
do k = 1, cols
tmp = 0.0d0
- !$omp target
+ !$omp target map(tofrom: tmp)
!$omp parallel do reduction(+:tmp)
do i = 1, rows
tmp = tmp + (Q(i,k) * Q(i,k))
real :: B(N), C(N), sum
integer :: N, block_size, num_teams, block_threads, i, i0
sum = 0.0e0
- !$omp target map(to: B, C, block_size, num_teams, block_threads)
+ !$omp target map(to: B, C, block_size, num_teams, block_threads) &
+ !$omp& map(tofrom: sum)
!$omp teams num_teams(num_teams) thread_limit(block_threads) &
!$omp& reduction(+:sum)
!$omp distribute
!$omp end parallel
b = 10
!$omp target data map (tofrom: a, d(2:3,4:4), q) map (from: l)
-!$omp target map (tofrom: b, d(2:3,4:4))
+!$omp target map (tofrom: b, d(2:3,4:4)) map (alloc: a, l)
l = .false.
if (a /= 22 .or. any (q /= 5)) l = .true.
if (lbound (q, 1) /= 19 .or. ubound (q, 1) /= 27) l = .true.
q = 14
d = 15
!$omp target update to (a, q, d(2:3,4:4))
-!$omp target map (tofrom: b, d(2:3,4:4))
+!$omp target map (tofrom: b, d(2:3,4:4)) map (alloc: a, l)
if (a /= 12 .or. b /= 13 .or. any (q /= 14)) l = .true.
l = l .or. any (d(2:3,4:4) /= 15)
!$omp end target
if (l) call abort
!$omp target teams distribute parallel do simd if (.not.l) device(a) &
!$omp & num_teams(b) dist_schedule(static, c) num_threads (h) &
-!$omp & reduction (+: m) safelen (n) schedule(static, o)
+!$omp & reduction (+: m) safelen (n) schedule(static, o) &
+!$omp & defaultmap(tofrom: scalar)
do p = 1, 64
m = m + 1
end do
c = 17
d = 75
!$omp target teams distribute parallel do simd default(none) &
- !$omp& firstprivate (a, b) shared(u, v, w) &
- !$omp& linear(d) linear(c:5) lastprivate(e)
+ !$omp& firstprivate (a, b, c) shared(u, v, w) &
+ !$omp& linear(d) lastprivate(e)
do d = a, b
u(d) = v(d) + w(d)
- c = c + 5
- e = c
+ e = c + d * 5
end do
a1 = 0
a2 = 0
!$omp target data map(a) map(to: m, n)
do i=1,n
t = 0.0d0
- !$omp target
+ !$omp target map(t)
!$omp parallel do reduction(+:t)
do j=1,m
t = t + a(j,i) * a(j,i)
--- /dev/null
+ common /blk/ q, e
+ integer :: q, r
+ logical :: e
+!$omp parallel
+!$omp single
+ call foo (2, 7)
+ r = bar (12, 18)
+!$omp end single
+!$omp end parallel
+ if (q .ne. 6 .or. r .ne. 17 .or. e) call abort
+contains
+ subroutine foo (a, b)
+ integer, intent (in) :: a, b
+ common /blk/ q, e
+ integer :: q, r, d
+ logical :: e
+!$omp taskloop lastprivate (q) nogroup
+ do d = a, b, 2
+ q = d
+ if (d < 2 .or. d > 6 .or. iand (d, 1) .ne. 0) then
+!$omp atomic write
+ e = .true.
+ end if
+ end do
+ end subroutine foo
+ function bar (a, b)
+ integer, intent (in) :: a, b
+ integer :: bar
+ common /blk/ q, e
+ integer :: q, r, d, s
+ logical :: e
+ s = 7
+!$omp taskloop lastprivate (s)
+ do d = a, b - 1
+ if (d < 12 .or. d > 17) then
+!$omp atomic write
+ e = .true.
+ end if
+ s = d
+ end do
+!$omp end taskloop
+ bar = s
+ end function bar
+end
--- /dev/null
+! { dg-do run }
+! { dg-options "-O2" }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+ integer, save :: u(1024), v(1024), w(1024), m
+ integer :: i
+ v = (/ (i, i = 1, 1024) /)
+ w = (/ (i + 1, i = 1, 1024) /)
+ !$omp parallel
+ !$omp single
+ call f1 (1, 1024)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (u(i) .ne. 2 * i + 1) call abort
+ v(i) = 1024 - i
+ w(i) = 512 - i
+ end do
+ !$omp parallel
+ !$omp single
+ call f2 (2, 1022, 17)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (i .lt. 2 .or. i .gt. 1022) then
+ if (u(i) .ne. 2 * i + 1) call abort
+ else
+ if (u(i) .ne. 1536 - 2 * i) call abort
+ end if
+ v(i) = i
+ w(i) = i + 1
+ end do
+ if (m .ne. (1023 + 2 * (1021 * 5 + 17) + 9)) call abort
+ !$omp parallel
+ !$omp single
+ call f3 (1, 1024)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (u(i) .ne. 2 * i + 1) call abort
+ v(i) = 1024 - i
+ w(i) = 512 - i
+ end do
+ if (m .ne. 1025) call abort
+ !$omp parallel
+ !$omp single
+ call f4 (0, 31, 1, 32)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (u(i) .ne. 1536 - 2 * i) call abort
+ v(i) = i
+ w(i) = i + 1
+ end do
+ if (m .ne. 32 + 33 + 1024) call abort
+ !$omp parallel
+ !$omp single
+ call f5 (0, 31, 1, 32)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (u(i) .ne. 2 * i + 1) call abort
+ end do
+ if (m .ne. 32 + 33) call abort
+contains
+ subroutine f1 (a, b)
+ integer, intent(in) :: a, b
+ integer :: d
+ !$omp taskloop simd default(none) shared(u, v, w) nogroup
+ do d = a, b
+ u(d) = v(d) + w(d)
+ end do
+ ! d is predetermined linear, so we can't let the tasks continue past
+ ! end of this function.
+ !$omp taskwait
+ end subroutine f1
+ subroutine f2 (a, b, cx)
+ integer, intent(in) :: a, b, cx
+ integer :: c, d, e
+ c = cx
+ !$omp taskloop simd default(none) shared(u, v, w) linear(d:1) linear(c:5) lastprivate(e)
+ do d = a, b
+ u(d) = v(d) + w(d)
+ c = c + 5
+ e = c + 9
+ end do
+ !$omp end taskloop simd
+ m = d + c + e
+ end subroutine f2
+ subroutine f3 (a, b)
+ integer, intent(in) :: a, b
+ integer, target :: d
+ integer, pointer :: p
+ !$omp taskloop simd default(none) shared(u, v, w) private (p)
+ do d = a, b
+ p => d
+ u(d) = v(d) + w(d)
+ p => null()
+ end do
+ m = d
+ end subroutine f3
+ subroutine f4 (a, b, c, d)
+ integer, intent(in) :: a, b, c, d
+ integer, target :: e, f
+ integer, pointer :: p, q
+ integer :: g, r
+ !$omp taskloop simd default(none) shared(u, v, w) lastprivate(g) collapse(2) private (r, p, q)
+ do e = a, b
+ do f = c, d
+ p => e
+ q => f
+ r = 32 * e + f
+ u(r) = v(r) + w(r)
+ g = r
+ p => null()
+ q => null()
+ end do
+ end do
+ m = e + f + g
+ end subroutine f4
+ subroutine f5 (a, b, c, d)
+ integer, intent(in) :: a, b, c, d
+ integer :: e, f, r
+ !$omp taskloop simd default(none) shared(u, v, w) collapse(2) private (r)
+ do e = a, b
+ do f = c, d
+ r = 32 * e + f
+ u(r) = v(r) + w(r)
+ end do
+ end do
+ m = e + f
+ end subroutine f5
+end
--- /dev/null
+! { dg-do run }
+! { dg-options "-O2" }
+
+ integer, save :: g
+ integer :: i
+ !$omp parallel
+ !$omp single
+ if (f1 (74) .ne. 63 + 4) call abort
+ g = 77
+ call f2
+ !$omp taskwait
+ if (g .ne. 63 + 9) call abort
+ if (f3 (7_8, 11_8, 2_8) .ne. 11 * 7 + 13) call abort
+ if (f4 (0_8, 31_8, 16_8, 46_8, 1_8, 2_8, 73) .ne. 32 + 5 * 48 &
+& + 11 * 31 + 17 * 46) call abort
+ !$omp end single
+ !$omp end parallel
+contains
+ function f1 (y)
+ integer, intent(in) :: y
+ integer :: i, f1, x
+ x = y
+ !$omp taskloop firstprivate(x)lastprivate(x)
+ do i = 0, 63
+ if (x .ne. 74) call abort
+ if (i .eq. 63) then
+ x = i + 4
+ end if
+ end do
+ f1 = x
+ end function f1
+ subroutine f2 ()
+ integer :: i
+ !$omp taskloop firstprivate(g)lastprivate(g)nogroup
+ do i = 0, 63
+ if (g .ne. 77) call abort
+ if (i .eq. 63) then
+ g = i + 9
+ end if
+ end do
+ end subroutine f2
+ function f3 (a, b, c)
+ integer(kind=8), intent(in) :: a, b, c
+ integer(kind=8) :: i, f3
+ integer :: l
+ !$omp taskloop default(none) lastprivate (i, l)
+ do i = a, b, c
+ l = i
+ end do
+ !$omp end taskloop
+ f3 = l * 7 + i
+ end function f3
+ function f4 (a, b, c, d, e, f, m)
+ integer(kind=8), intent(in) :: a, b, c, d, e, f
+ integer(kind=8) :: i, j, f4
+ integer, intent(in) :: m
+ integer :: l, k
+ k = m
+ !$omp taskloop default (none) collapse (2) firstprivate (k) &
+ !$omp & lastprivate (i, j, k, l)
+ do i = a, b, e
+ do j = c, d, f
+ if (k .ne. 73) call abort
+ if (i .eq. 31 .and. j .eq. 46) then
+ k = i
+ end if
+ l = j
+ end do
+ end do
+ f4 = i + 5 * j + 11 * k + 17 * l
+ end function f4
+end
--- /dev/null
+! { dg-do run }
+! { dg-options "-O2" }
+
+ integer, save :: u(64), v
+ integer :: min_iters, max_iters, ntasks, cnt
+ procedure(grainsize), pointer :: fn
+ !$omp parallel
+ !$omp single
+ fn => grainsize
+ ! If grainsize is present, # of task loop iters is
+ ! >= grainsize && < 2 * grainsize,
+ ! unless # of loop iterations is smaller than grainsize.
+ call test (0, 79, 1, 17, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 79) call abort
+ if (min_iters .lt. 17 .or. max_iters .ge. 17 * 2) call abort
+ call test (-49, 2541, 7, 28, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 370) call abort
+ if (min_iters .lt. 28 .or. max_iters .ge. 28 * 2) call abort
+ call test (7, 21, 2, 15, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 7) call abort
+ if (min_iters .ne. 7 .or. max_iters .ne. 7) call abort
+ if (ntasks .ne. 1) call abort
+ fn => num_tasks
+ ! If num_tasks is present, # of task loop iters is
+ ! min (# of loop iters, num_tasks).
+ call test (-51, 2500, 48, 9, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 54 .or. ntasks .ne. 9) call abort
+ call test (0, 25, 2, 17, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 13 .or. ntasks .ne. 13) call abort
+ !$omp end single
+ !$omp end parallel
+contains
+ subroutine grainsize (a, b, c, d)
+ integer, intent (in) :: a, b, c, d
+ integer :: i, j, k
+ j = 0
+ k = 0
+ !$omp taskloop firstprivate (j, k) grainsize (d)
+ do i = a, b - 1, c
+ if (j .eq. 0) then
+ !$omp atomic capture
+ k = v
+ v = v + 1
+ !$omp end atomic
+ if (k .ge. 64) call abort
+ end if
+ j = j + 1
+ u(k + 1) = j
+ end do
+ end subroutine grainsize
+ subroutine num_tasks (a, b, c, d)
+ integer, intent (in) :: a, b, c, d
+ integer :: i, j, k
+ j = 0
+ k = 0
+ !$omp taskloop firstprivate (j, k) num_tasks (d)
+ do i = a, b - 1, c
+ if (j .eq. 0) then
+ !$omp atomic capture
+ k = v
+ v = v + 1
+ !$omp end atomic
+ if (k .ge. 64) call abort
+ end if
+ j = j + 1
+ u(k + 1) = j
+ end do
+ end subroutine num_tasks
+ subroutine test (a, b, c, d, fn, num_tasks, min_iters, max_iters, cnt)
+ integer, intent (in) :: a, b, c, d
+ procedure(grainsize), pointer :: fn
+ integer, intent (out) :: num_tasks, min_iters, max_iters, cnt
+ integer :: i
+ u(:) = 0
+ v = 0
+ cnt = 0
+ call fn (a, b, c, d)
+ min_iters = 0
+ max_iters = 0
+ num_tasks = v
+ if (v .ne. 0) then
+ min_iters = minval (u(1:v))
+ max_iters = maxval (u(1:v))
+ cnt = sum (u(1:v))
+ end if
+ end subroutine test
+end
projects / gcc.git / commitdiff