git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

omp-low.c (lower_omp_target): Fix up argument to is_reference. 

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.

From-SVN: r242037
This commit is contained in:
Jakub Jelinek 2016-11-10 12:38:05 +01:00
parent 86bc850653
commit b4c3a85be9
52 changed files with 4151 additions and 597 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/ChangeLog
View File

@ -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

227
gcc/fortran/ChangeLog
View File

@ -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>

224
gcc/fortran/dump-parse-tree.c
View File

@ -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;

4
gcc/fortran/f95-lang.c
View File

@ -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

16
gcc/fortran/frontend-passes.c
View File

@ -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++)

67
gcc/fortran/gfortran.h
View File

@ -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 *);

16
gcc/fortran/match.c
View File

@ -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");

10
gcc/fortran/match.h
View File

@ -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);

9
gcc/fortran/module.c
View File

@ -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;

1674
gcc/fortran/openmp.c
View File

File diff suppressed because it is too large Load Diff

108
gcc/fortran/parse.c
View File

@ -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:

22
gcc/fortran/resolve.c
View File

@ -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:

15
gcc/fortran/st.c
View File

@ -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:

32
gcc/fortran/symbol.c
View File

@ -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);
@ -1299,6 +1312,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;

6
gcc/fortran/trans-common.c
View File

@ -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));

5
gcc/fortran/trans-decl.c
View File

@ -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);

682
gcc/fortran/trans-openmp.c
View File

File diff suppressed because it is too large Load Diff

8
gcc/fortran/trans.c
View File

@ -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:

1
gcc/fortran/trans.h
View File

@ -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);

127
gcc/gimplify.c
View File

@ -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)

5
gcc/langhooks-def.h
View File

@ -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. */

18
gcc/langhooks.c
View File

@ -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. */

4
gcc/langhooks.h
View File

@ -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. */

92
gcc/omp-low.c
View File

@ -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));

12
gcc/testsuite/ChangeLog
View File

@ -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>

20
gcc/testsuite/gfortran.dg/gomp/declare-simd-2.f90 Normal file
View File

@ -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

27
gcc/testsuite/gfortran.dg/gomp/declare-target-1.f90 Normal file
View File

@ -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

51
gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 Normal file
View File

@ -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

58
gcc/testsuite/gfortran.dg/gomp/linear-1.f90 Normal file
View File

@ -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

2
gcc/testsuite/gfortran.dg/gomp/pr77516.f90
View File

@ -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

40
gcc/testsuite/gfortran.dg/gomp/target1.f90
View File

@ -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

4
gcc/varpool.c
View File

@ -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)

31
libgomp/ChangeLog
View File

@ -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>

3
libgomp/testsuite/libgomp.c/doacross-1.c
View File

@ -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 ();

3
libgomp/testsuite/libgomp.c/doacross-2.c
View File

@ -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 ();

3
libgomp/testsuite/libgomp.c/doacross-3.c
View File

@ -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 ();

209
libgomp/testsuite/libgomp.fortran/doacross1.f90 Normal file
View File

@ -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

261
libgomp/testsuite/libgomp.fortran/doacross2.f90 Normal file
View File

@ -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

261
libgomp/testsuite/libgomp.fortran/doacross3.f90 Normal file
View File

@ -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

2
libgomp/testsuite/libgomp.fortran/examples-4/declare_target-1.f90
View File

@ -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

2
libgomp/testsuite/libgomp.fortran/examples-4/declare_target-2.f90
View File

@ -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

2
libgomp/testsuite/libgomp.fortran/examples-4/declare_target-4.f90
View File

@ -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)

2
libgomp/testsuite/libgomp.fortran/examples-4/declare_target-5.f90
View File

@ -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

2
libgomp/testsuite/libgomp.fortran/examples-4/target_data-3.f90
View File

@ -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))

3
libgomp/testsuite/libgomp.fortran/examples-4/teams-2.f90
View File

@ -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

7
libgomp/testsuite/libgomp.fortran/nestedfn5.f90
View File

@ -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

7
libgomp/testsuite/libgomp.fortran/pr66199-2.f90
View File

@ -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

2
libgomp/testsuite/libgomp.fortran/target4.f90
View File

@ -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)

44
libgomp/testsuite/libgomp.fortran/taskloop1.f90 Normal file
View File

@ -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

134
libgomp/testsuite/libgomp.fortran/taskloop2.f90 Normal file
View File

@ -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

72
libgomp/testsuite/libgomp.fortran/taskloop3.f90 Normal file
View File

@ -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

87
libgomp/testsuite/libgomp.fortran/taskloop4.f90 Normal file
View File

@ -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