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