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