OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

tree.h (OMP_CLAUSE_LINEAR_STMT): Define.

Browse Source 
* tree.h (OMP_CLAUSE_LINEAR_STMT): Define.
	* tree.c (omp_clause_num_ops): Increase OMP_CLAUSE_LINEAR
	number of operands to 3.
	(walk_tree_1): Walk all operands of OMP_CLAUSE_LINEAR.
	* tree-nested.c (convert_nonlocal_omp_clauses,
	convert_local_omp_clauses): Handle OMP_CLAUSE_DEPEND.
	* gimplify.c (gimplify_scan_omp_clauses): Handle
	OMP_CLAUSE_LINEAR_STMT.
	* omp-low.c (lower_rec_input_clauses): Fix typo.
	(maybe_add_implicit_barrier_cancel, lower_omp_1): Add
	cast between Fortran boolean_type_node and C _Bool if
	needed.
gcc/fortran/
	* gfortran.h (gfc_statement): Add ST_OMP_CANCEL,
	ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP,
	ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD,
	ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and
	ST_OMP_DECLARE_SIMD.
	(gfc_omp_namelist): New typedef.
	(gfc_get_omp_namelist): Define.
	(OMP_LIST_UNIFORM, OMP_LIST_ALIGNED, OMP_LIST_LINEAR,
	OMP_LIST_DEPEND_IN, OMP_LIST_DEPEND_OUT): New clause list kinds.
	(gfc_omp_proc_bind_kind, gfc_omp_cancel_kind): New enums.
	(gfc_omp_clauses): Change type of lists to gfc_omp_namelist *.
	Add inbranch, notinbranch, cancel, proc_bind, safelen_expr and
	simdlen_expr fields.
	(gfc_omp_declare_simd): New typedef.
	(gfc_get_omp_declare_simd): Define.
	(gfc_namespace): Add omp_declare_simd field.
	(gfc_exec_op): Add EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT,
	EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD and
	EXEC_OMP_PARALLEL_DO_SIMD.
	(gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_MASK, GFC_OMP_ATOMIC_SEQ_CST
	and GFC_OMP_ATOMIC_SWAP.
	(gfc_code): Change type of omp_namelist field to gfc_omp_namelist *.
	(gfc_free_omp_namelist, gfc_free_omp_declare_simd,
	gfc_free_omp_declare_simd_list, gfc_resolve_omp_declare_simd): New
	prototypes.
	* trans-stmt.h (gfc_trans_omp_declare_simd): New prototype.
	* symbol.c (gfc_free_namespace): Call gfc_free_omp_declare_simd.
	* openmp.c (gfc_free_omp_clauses): Free safelen_expr and
	simdlen_expr.  Use gfc_free_omp_namelist instead of
	gfc_free_namelist.
	(gfc_free_omp_declare_simd, gfc_free_omp_declare_simd_list): New
	functions.
	(gfc_match_omp_variable_list): Add end_colon, headp and
	allow_sections arguments.  Handle parsing of array sections.
	Use *omp_namelist* instead of *namelist* data structure and
	functions/macros.  Allow termination at : character.
	(OMP_CLAUSE_ALIGNED, OMP_CLAUSE_DEPEND, OMP_CLAUSE_INBRANCH,
	OMP_CLAUSE_LINEAR, OMP_CLAUSE_NOTINBRANCH, OMP_CLAUSE_PROC_BIND,
	OMP_CLAUSE_SAFELEN, OMP_CLAUSE_SIMDLEN, OMP_CLAUSE_UNIFORM): Define.
	(gfc_match_omp_clauses): Change first and needs_space variables
	into arguments with default values.  Parse inbranch, notinbranch,
	proc_bind, safelen, simdlen, uniform, linear, aligned and
	depend clauses.
	(OMP_PARALLEL_CLAUSES): Add OMP_CLAUSE_PROC_BIND.
	(OMP_DECLARE_SIMD_CLAUSES, OMP_SIMD_CLAUSES): Define.
	(OMP_TASK_CLAUSES): Add OMP_CLAUSE_DEPEND.
	(gfc_match_omp_do_simd): New function.
	(gfc_match_omp_flush): Use *omp_namelist* instead of *namelist*
	data structure and functions/macros.
	(gfc_match_omp_simd, gfc_match_omp_declare_simd,
	gfc_match_omp_parallel_do_simd): New functions.
	(gfc_match_omp_atomic): Handle seq_cst clause.  Handle atomic swap.
	(gfc_match_omp_taskgroup, gfc_match_omp_cancel_kind,
	gfc_match_omp_cancel, gfc_match_omp_cancellation_point): New
	functions.
	(resolve_omp_clauses): Add where, omp_clauses and ns arguments.
	Use *omp_namelist* instead of *namelist* data structure and
	functions/macros.  Resolve uniform, aligned, linear, depend,
	safelen and simdlen clauses.
	(resolve_omp_atomic): Adjust for GFC_OMP_ATOMIC_{MASK,SEQ_CST,SWAP}
	addition, recognize atomic swap.
	(gfc_resolve_omp_parallel_blocks): Use gfc_omp_namelist instead
	of gfc_namelist.  Handle EXEC_OMP_PARALLEL_DO_SIMD the same as
	EXEC_OMP_PARALLEL_DO.
	(gfc_resolve_do_iterator): Use *omp_namelist* instead of *namelist*
	data structure and functions/macros.
	(resolve_omp_do): Likewise.  Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD,
	EXEC_OMP_PARALLEL_DO_SIMD.
	(gfc_resolve_omp_directive): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD,
	EXEC_OMP_PARALLEL_DO_SIMD and EXEC_OMP_CANCEL.  Adjust
	resolve_omp_clauses caller.
	(gfc_resolve_omp_declare_simd): New function.
	* parse.c (decode_omp_directive): Parse cancellation point, cancel,
	declare simd, end do simd, end simd, end parallel do simd,
	end taskgroup, parallel do simd, simd and taskgroup directives.
	(case_executable): Add ST_OMP_CANCEL and ST_OMP_CANCELLATION_POINT.
	(case_exec_markers): Add ST_OMP_TASKGROUP, case ST_OMP_SIMD,
	ST_OMP_DO_SIMD and ST_OMP_PARALLEL_DO_SIMD.
	(case_decl): Add ST_OMP_DECLARE_SIMD.
	(gfc_ascii_statement): Handle ST_OMP_CANCEL,
	ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP,
	ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD,
	ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and
	ST_OMP_DECLARE_SIMD.
	(parse_omp_do): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD and
	ST_OMP_PARALLEL_DO_SIMD.
	(parse_omp_atomic): Adjust for GFC_OMP_ATOMIC_* additions.
	(parse_omp_structured_block): Handle ST_OMP_TASKGROUP and
	ST_OMP_PARALLEL_DO_SIMD.
	(parse_executable): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD,
	ST_OMP_PARALLEL_DO_SIMD and ST_OMP_TASKGROUP.
	* trans-decl.c (gfc_get_extern_function_decl,
	gfc_create_function_decl): Call gfc_trans_omp_declare_simd if
	needed.
	* frontend-passes.c (gfc_code_walker): Handle EXEC_OMP_SIMD,
	EXEC_OMP_DO_SIMD and EXEC_OMP_PARALLEL_DO_SIMD.  Walk
	safelen_expr and simdlen_expr.  Walk expressions in gfc_omp_namelist
	of depend, aligned and linear clauses.
	* match.c (match_exit_cycle): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD
	and EXEC_OMP_PARALLEL_DO_SIMD.
	(gfc_free_omp_namelist): New function.
	* dump-parse-tree.c (show_namelist): Removed.
	(show_omp_namelist): New function.
	(show_omp_node): Handle OpenMP 4.0 additions.
	(show_code_node): Handle EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT,
	EXEC_OMP_DO_SIMD, EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and
	EXEC_OMP_TASKGROUP.
	* match.h (gfc_match_omp_cancel, gfc_match_omp_cancellation_point,
	gfc_match_omp_declare_simd, gfc_match_omp_do_simd,
	gfc_match_omp_parallel_do_simd, gfc_match_omp_simd,
	gfc_match_omp_taskgroup): New prototypes.
	* trans-openmp.c (gfc_trans_omp_variable): Add declare_simd
	argument, handle it.  Allow current_function_decl to be NULL.
	(gfc_trans_omp_variable_list): Add declare_simd argument, pass
	it through to gfc_trans_omp_variable and disregard whether
	sym is referenced if declare_simd is true.  Work on gfc_omp_namelist
	instead of gfc_namelist.
	(gfc_trans_omp_reduction_list): Work on gfc_omp_namelist instead of
	gfc_namelist.  Adjust gfc_trans_omp_variable caller.
	(gfc_trans_omp_clauses): Add declare_simd argument, pass it through
	to gfc_trans_omp_variable{,_list} callers.  Work on gfc_omp_namelist
	instead of gfc_namelist.  Handle inbranch, notinbranch, safelen,
	simdlen, depend, uniform, linear, proc_bind and aligned clauses.
	Handle cancel kind.
	(gfc_trans_omp_atomic): Handle seq_cst clause, handle atomic swap,
	adjust for GFC_OMP_ATOMIC_* changes.
	(gfc_trans_omp_cancel, gfc_trans_omp_cancellation_point): New
	functions.
	(gfc_trans_omp_do): Add op argument, handle simd translation into
	generic.
	(GFC_OMP_SPLIT_SIMD, GFC_OMP_SPLIT_DO, GFC_OMP_SPLIT_PARALLEL,
	GFC_OMP_SPLIT_NUM, GFC_OMP_MASK_SIMD, GFC_OMP_MASK_DO,
	GFC_OMP_MASK_PARALLEL): New.
	(gfc_split_omp_clauses, gfc_trans_omp_do_simd): New functions.
	(gfc_trans_omp_parallel_do): Rework to use gfc_split_omp_clauses.
	(gfc_trans_omp_parallel_do_simd, gfc_trans_omp_taskgroup): New
	functions.
	(gfc_trans_omp_directive): Handle EXEC_OMP_CANCEL,
	EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD,
	EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
	Adjust gfc_trans_omp_do caller.
	(gfc_trans_omp_declare_simd): New function.
	* st.c (gfc_free_statement): Handle EXEC_OMP_CANCEL,
	EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD,
	EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
	For EXEC_OMP_FLUSH call gfc_free_omp_namelist instead of
	gfc_free_namelist.
	* module.c (omp_declare_simd_clauses): New variable.
	(mio_omp_declare_simd): New function.
	(mio_symbol): Call it.
	* trans.c (trans_code): Handle EXEC_OMP_CANCEL,
	EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD,
	EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
	* resolve.c (gfc_resolve_blocks): Handle EXEC_OMP_DO_SIMD,  
	EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
	(resolve_code): Handle EXEC_OMP_CANCEL,
	EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD,
	EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
	(resolve_types): Call gfc_resolve_omp_declare_simd.
gcc/testsuite/
	* gfortran.dg/gomp/affinity-1.f90: New test.
libgomp/
	* testsuite/libgomp.fortran/cancel-do-1.f90: New test.
	* testsuite/libgomp.fortran/cancel-do-2.f90: New test.
	* testsuite/libgomp.fortran/cancel-parallel-1.f90: New test.
	* testsuite/libgomp.fortran/cancel-parallel-3.f90: New test.
	* testsuite/libgomp.fortran/cancel-sections-1.f90: New test.
	* testsuite/libgomp.fortran/cancel-taskgroup-2.f90: New test.
	* testsuite/libgomp.fortran/declare-simd-1.f90: New test.
	* testsuite/libgomp.fortran/declare-simd-2.f90: New test.
	* testsuite/libgomp.fortran/declare-simd-3.f90: New test.
	* testsuite/libgomp.fortran/depend-1.f90: New test.
	* testsuite/libgomp.fortran/depend-2.f90: New test.
	* testsuite/libgomp.fortran/omp_atomic5.f90: New test.
	* testsuite/libgomp.fortran/simd1.f90: New test.
	* testsuite/libgomp.fortran/simd2.f90: New test.
	* testsuite/libgomp.fortran/simd3.f90: New test.
	* testsuite/libgomp.fortran/simd4.f90: New test.
	* testsuite/libgomp.fortran/taskgroup1.f90: New test.

From-SVN: r210313
This commit is contained in:
Jakub Jelinek 2014-05-11 22:26:36 +02:00 committed by Jakub Jelinek
parent 7588d8aae4
commit dd2fc5256e
42 changed files with 2983 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ChangeLog
View File

@ -1,3 +1,18 @@
2014-05-11 Jakub Jelinek <jakub@redhat.com>
* tree.h (OMP_CLAUSE_LINEAR_STMT): Define.
* tree.c (omp_clause_num_ops): Increase OMP_CLAUSE_LINEAR
number of operands to 3.
(walk_tree_1): Walk all operands of OMP_CLAUSE_LINEAR.
* tree-nested.c (convert_nonlocal_omp_clauses,
convert_local_omp_clauses): Handle OMP_CLAUSE_DEPEND.
* gimplify.c (gimplify_scan_omp_clauses): Handle
OMP_CLAUSE_LINEAR_STMT.
* omp-low.c (lower_rec_input_clauses): Fix typo.
(maybe_add_implicit_barrier_cancel, lower_omp_1): Add
cast between Fortran boolean_type_node and C _Bool if
needed.
2014-05-11 Richard Sandiford <rdsandiford@googlemail.com>
PR tree-optimization/61136

162
gcc/fortran/ChangeLog
View File

@ -1,3 +1,165 @@
2014-05-11 Jakub Jelinek <jakub@redhat.com>
* gfortran.h (gfc_statement): Add ST_OMP_CANCEL,
ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP,
ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD,
ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and
ST_OMP_DECLARE_SIMD.
(gfc_omp_namelist): New typedef.
(gfc_get_omp_namelist): Define.
(OMP_LIST_UNIFORM, OMP_LIST_ALIGNED, OMP_LIST_LINEAR,
OMP_LIST_DEPEND_IN, OMP_LIST_DEPEND_OUT): New clause list kinds.
(gfc_omp_proc_bind_kind, gfc_omp_cancel_kind): New enums.
(gfc_omp_clauses): Change type of lists to gfc_omp_namelist *.
Add inbranch, notinbranch, cancel, proc_bind, safelen_expr and
simdlen_expr fields.
(gfc_omp_declare_simd): New typedef.
(gfc_get_omp_declare_simd): Define.
(gfc_namespace): Add omp_declare_simd field.
(gfc_exec_op): Add EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT,
EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD and
EXEC_OMP_PARALLEL_DO_SIMD.
(gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_MASK, GFC_OMP_ATOMIC_SEQ_CST
and GFC_OMP_ATOMIC_SWAP.
(gfc_code): Change type of omp_namelist field to gfc_omp_namelist *.
(gfc_free_omp_namelist, gfc_free_omp_declare_simd,
gfc_free_omp_declare_simd_list, gfc_resolve_omp_declare_simd): New
prototypes.
* trans-stmt.h (gfc_trans_omp_declare_simd): New prototype.
* symbol.c (gfc_free_namespace): Call gfc_free_omp_declare_simd.
* openmp.c (gfc_free_omp_clauses): Free safelen_expr and
simdlen_expr. Use gfc_free_omp_namelist instead of
gfc_free_namelist.
(gfc_free_omp_declare_simd, gfc_free_omp_declare_simd_list): New
functions.
(gfc_match_omp_variable_list): Add end_colon, headp and
allow_sections arguments. Handle parsing of array sections.
Use *omp_namelist* instead of *namelist* data structure and
functions/macros. Allow termination at : character.
(OMP_CLAUSE_ALIGNED, OMP_CLAUSE_DEPEND, OMP_CLAUSE_INBRANCH,
OMP_CLAUSE_LINEAR, OMP_CLAUSE_NOTINBRANCH, OMP_CLAUSE_PROC_BIND,
OMP_CLAUSE_SAFELEN, OMP_CLAUSE_SIMDLEN, OMP_CLAUSE_UNIFORM): Define.
(gfc_match_omp_clauses): Change first and needs_space variables
into arguments with default values. Parse inbranch, notinbranch,
proc_bind, safelen, simdlen, uniform, linear, aligned and
depend clauses.
(OMP_PARALLEL_CLAUSES): Add OMP_CLAUSE_PROC_BIND.
(OMP_DECLARE_SIMD_CLAUSES, OMP_SIMD_CLAUSES): Define.
(OMP_TASK_CLAUSES): Add OMP_CLAUSE_DEPEND.
(gfc_match_omp_do_simd): New function.
(gfc_match_omp_flush): Use *omp_namelist* instead of *namelist*
data structure and functions/macros.
(gfc_match_omp_simd, gfc_match_omp_declare_simd,
gfc_match_omp_parallel_do_simd): New functions.
(gfc_match_omp_atomic): Handle seq_cst clause. Handle atomic swap.
(gfc_match_omp_taskgroup, gfc_match_omp_cancel_kind,
gfc_match_omp_cancel, gfc_match_omp_cancellation_point): New
functions.
(resolve_omp_clauses): Add where, omp_clauses and ns arguments.
Use *omp_namelist* instead of *namelist* data structure and
functions/macros. Resolve uniform, aligned, linear, depend,
safelen and simdlen clauses.
(resolve_omp_atomic): Adjust for GFC_OMP_ATOMIC_{MASK,SEQ_CST,SWAP}
addition, recognize atomic swap.
(gfc_resolve_omp_parallel_blocks): Use gfc_omp_namelist instead
of gfc_namelist. Handle EXEC_OMP_PARALLEL_DO_SIMD the same as
EXEC_OMP_PARALLEL_DO.
(gfc_resolve_do_iterator): Use *omp_namelist* instead of *namelist*
data structure and functions/macros.
(resolve_omp_do): Likewise. Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD,
EXEC_OMP_PARALLEL_DO_SIMD.
(gfc_resolve_omp_directive): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD,
EXEC_OMP_PARALLEL_DO_SIMD and EXEC_OMP_CANCEL. Adjust
resolve_omp_clauses caller.
(gfc_resolve_omp_declare_simd): New function.
* parse.c (decode_omp_directive): Parse cancellation point, cancel,
declare simd, end do simd, end simd, end parallel do simd,
end taskgroup, parallel do simd, simd and taskgroup directives.
(case_executable): Add ST_OMP_CANCEL and ST_OMP_CANCELLATION_POINT.
(case_exec_markers): Add ST_OMP_TASKGROUP, case ST_OMP_SIMD,
ST_OMP_DO_SIMD and ST_OMP_PARALLEL_DO_SIMD.
(case_decl): Add ST_OMP_DECLARE_SIMD.
(gfc_ascii_statement): Handle ST_OMP_CANCEL,
ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP,
ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD,
ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and
ST_OMP_DECLARE_SIMD.
(parse_omp_do): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD and
ST_OMP_PARALLEL_DO_SIMD.
(parse_omp_atomic): Adjust for GFC_OMP_ATOMIC_* additions.
(parse_omp_structured_block): Handle ST_OMP_TASKGROUP and
ST_OMP_PARALLEL_DO_SIMD.
(parse_executable): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD,
ST_OMP_PARALLEL_DO_SIMD and ST_OMP_TASKGROUP.
* trans-decl.c (gfc_get_extern_function_decl,
gfc_create_function_decl): Call gfc_trans_omp_declare_simd if
needed.
* frontend-passes.c (gfc_code_walker): Handle EXEC_OMP_SIMD,
EXEC_OMP_DO_SIMD and EXEC_OMP_PARALLEL_DO_SIMD. Walk
safelen_expr and simdlen_expr. Walk expressions in gfc_omp_namelist
of depend, aligned and linear clauses.
* match.c (match_exit_cycle): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD
and EXEC_OMP_PARALLEL_DO_SIMD.
(gfc_free_omp_namelist): New function.
* dump-parse-tree.c (show_namelist): Removed.
(show_omp_namelist): New function.
(show_omp_node): Handle OpenMP 4.0 additions.
(show_code_node): Handle EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT,
EXEC_OMP_DO_SIMD, EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and
EXEC_OMP_TASKGROUP.
* match.h (gfc_match_omp_cancel, gfc_match_omp_cancellation_point,
gfc_match_omp_declare_simd, gfc_match_omp_do_simd,
gfc_match_omp_parallel_do_simd, gfc_match_omp_simd,
gfc_match_omp_taskgroup): New prototypes.
* trans-openmp.c (gfc_trans_omp_variable): Add declare_simd
argument, handle it. Allow current_function_decl to be NULL.
(gfc_trans_omp_variable_list): Add declare_simd argument, pass
it through to gfc_trans_omp_variable and disregard whether
sym is referenced if declare_simd is true. Work on gfc_omp_namelist
instead of gfc_namelist.
(gfc_trans_omp_reduction_list): Work on gfc_omp_namelist instead of
gfc_namelist. Adjust gfc_trans_omp_variable caller.
(gfc_trans_omp_clauses): Add declare_simd argument, pass it through
to gfc_trans_omp_variable{,_list} callers. Work on gfc_omp_namelist
instead of gfc_namelist. Handle inbranch, notinbranch, safelen,
simdlen, depend, uniform, linear, proc_bind and aligned clauses.
Handle cancel kind.
(gfc_trans_omp_atomic): Handle seq_cst clause, handle atomic swap,
adjust for GFC_OMP_ATOMIC_* changes.
(gfc_trans_omp_cancel, gfc_trans_omp_cancellation_point): New
functions.
(gfc_trans_omp_do): Add op argument, handle simd translation into
generic.
(GFC_OMP_SPLIT_SIMD, GFC_OMP_SPLIT_DO, GFC_OMP_SPLIT_PARALLEL,
GFC_OMP_SPLIT_NUM, GFC_OMP_MASK_SIMD, GFC_OMP_MASK_DO,
GFC_OMP_MASK_PARALLEL): New.
(gfc_split_omp_clauses, gfc_trans_omp_do_simd): New functions.
(gfc_trans_omp_parallel_do): Rework to use gfc_split_omp_clauses.
(gfc_trans_omp_parallel_do_simd, gfc_trans_omp_taskgroup): New
functions.
(gfc_trans_omp_directive): Handle EXEC_OMP_CANCEL,
EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD,
EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
Adjust gfc_trans_omp_do caller.
(gfc_trans_omp_declare_simd): New function.
* st.c (gfc_free_statement): Handle EXEC_OMP_CANCEL,
EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD,
EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
For EXEC_OMP_FLUSH call gfc_free_omp_namelist instead of
gfc_free_namelist.
* module.c (omp_declare_simd_clauses): New variable.
(mio_omp_declare_simd): New function.
(mio_symbol): Call it.
* trans.c (trans_code): Handle EXEC_OMP_CANCEL,
EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD,
EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
* resolve.c (gfc_resolve_blocks): Handle EXEC_OMP_DO_SIMD,
EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
(resolve_code): Handle EXEC_OMP_CANCEL,
EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD,
EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP.
(resolve_types): Call gfc_resolve_omp_declare_simd.
2014-05-11 Tobias Burnus <burnus@net-b.de>
* trans-intrinsic.c (gfc_build_builtin_function_decls):

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

@ -1016,11 +1016,19 @@ show_code (int level, gfc_code *c)
}
static void
show_namelist (gfc_namelist *n)
show_omp_namelist (gfc_omp_namelist *n)
{
for (; n->next; n = n->next)
fprintf (dumpfile, "%s,", n->sym->name);
fprintf (dumpfile, "%s", n->sym->name);
for (; n; n = n->next)
{
fprintf (dumpfile, "%s", n->sym->name);
if (n->expr)
{
fputc (':', dumpfile);
show_expr (n->expr);
}
if (n->next)
fputc (',', dumpfile);
}
}
/* Show a single OpenMP directive node and everything underneath it
@ -1036,18 +1044,24 @@ show_omp_node (int level, gfc_code *c)
{
case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
case EXEC_OMP_BARRIER: name = "BARRIER"; break;
case EXEC_OMP_CANCEL: name = "CANCEL"; break;
case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; break;
case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
case EXEC_OMP_FLUSH: name = "FLUSH"; break;
case EXEC_OMP_DO: name = "DO"; break;
case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
case EXEC_OMP_MASTER: name = "MASTER"; break;
case EXEC_OMP_ORDERED: name = "ORDERED"; break;
case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
case EXEC_OMP_SIMD: name = "SIMD"; break;
case EXEC_OMP_SINGLE: name = "SINGLE"; break;
case EXEC_OMP_TASK: name = "TASK"; break;
case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break;
case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
@ -1057,11 +1071,16 @@ show_omp_node (int level, gfc_code *c)
fprintf (dumpfile, "!$OMP %s", name);
switch (c->op)
{
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_PARALLEL_WORKSHARE:
@ -1076,7 +1095,7 @@ show_omp_node (int level, gfc_code *c)
if (c->ext.omp_namelist)
{
fputs (" (", dumpfile);
show_namelist (c->ext.omp_namelist);
show_omp_namelist (c->ext.omp_namelist);
fputc (')', dumpfile);
}
return;
@ -1091,6 +1110,23 @@ show_omp_node (int level, gfc_code *c)
{
int list_type;
switch (omp_clauses->cancel)
{
case OMP_CANCEL_UNKNOWN:
break;
case OMP_CANCEL_PARALLEL:
fputs (" PARALLEL", dumpfile);
break;
case OMP_CANCEL_SECTIONS:
fputs (" SECTIONS", dumpfile);
break;
case OMP_CANCEL_DO:
fputs (" DO", dumpfile);
break;
case OMP_CANCEL_TASKGROUP:
fputs (" TASKGROUP", dumpfile);
break;
}
if (omp_clauses->if_expr)
{
fputs (" IF(", dumpfile);
@ -1156,7 +1192,7 @@ show_omp_node (int level, gfc_code *c)
if (omp_clauses->lists[list_type] != NULL
&& list_type != OMP_LIST_COPYPRIVATE)
{
const char *type;
const char *type = NULL;
if (list_type >= OMP_LIST_REDUCTION_FIRST)
{
switch (list_type)
@ -1187,14 +1223,53 @@ show_omp_node (int level, gfc_code *c)
case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
case OMP_LIST_SHARED: type = "SHARED"; break;
case OMP_LIST_COPYIN: type = "COPYIN"; break;
case OMP_LIST_UNIFORM: type = "UNIFORM"; break;
case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
case OMP_LIST_LINEAR: type = "LINEAR"; break;
case OMP_LIST_DEPEND_IN:
fprintf (dumpfile, " DEPEND(IN:");
break;
case OMP_LIST_DEPEND_OUT:
fprintf (dumpfile, " DEPEND(OUT:");
break;
default:
gcc_unreachable ();
}
fprintf (dumpfile, " %s(", type);
if (type)
fprintf (dumpfile, " %s(", type);
}
show_namelist (omp_clauses->lists[list_type]);
show_omp_namelist (omp_clauses->lists[list_type]);
fputc (')', dumpfile);
}
if (omp_clauses->safelen_expr)
{
fputs (" SAFELEN(", dumpfile);
show_expr (omp_clauses->safelen_expr);
fputc (')', dumpfile);
}
if (omp_clauses->simdlen_expr)
{
fputs (" SIMDLEN(", dumpfile);
show_expr (omp_clauses->simdlen_expr);
fputc (')', dumpfile);
}
if (omp_clauses->inbranch)
fputs (" INBRANCH", dumpfile);
if (omp_clauses->notinbranch)
fputs (" NOTINBRANCH", dumpfile);
if (omp_clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
{
const char *type;
switch (omp_clauses->proc_bind)
{
case OMP_PROC_BIND_MASTER: type = "MASTER"; break;
case OMP_PROC_BIND_SPREAD: type = "SPREAD"; break;
case OMP_PROC_BIND_CLOSE: type = "CLOSE"; break;
default:
gcc_unreachable ();
}
fprintf (dumpfile, " PROC_BIND(%s)", type);
}
}
fputc ('\n', dumpfile);
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@ -1214,6 +1289,7 @@ show_omp_node (int level, gfc_code *c)
show_code (level + 1, c->block->next);
if (c->op == EXEC_OMP_ATOMIC)
return;
fputc ('\n', dumpfile);
code_indent (level, 0);
fprintf (dumpfile, "!$OMP END %s", name);
if (omp_clauses != NULL)
@ -1221,7 +1297,7 @@ show_omp_node (int level, gfc_code *c)
if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
{
fputs (" COPYPRIVATE(", dumpfile);
show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
show_omp_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
fputc (')', dumpfile);
}
else if (omp_clauses->nowait)
@ -2195,19 +2271,25 @@ show_code_node (int level, gfc_code *c)
break;
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_FLUSH:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_MASTER:
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_TASK:
case EXEC_OMP_TASKGROUP:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
case EXEC_OMP_WORKSHARE:

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

@ -2112,6 +2112,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
in_omp_workshare = false;
@ -2128,9 +2129,11 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
/* Fall through */
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_SIMD:
case EXEC_OMP_TASK:
/* Come to this label only from the
@ -2144,7 +2147,24 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
WALK_SUBEXPR (co->ext.omp_clauses->final_expr);
WALK_SUBEXPR (co->ext.omp_clauses->num_threads);
WALK_SUBEXPR (co->ext.omp_clauses->chunk_size);
WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr);
WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr);
}
{
gfc_omp_namelist *n;
for (n = co->ext.omp_clauses->lists[OMP_LIST_ALIGNED];
n; n = n->next)
WALK_SUBEXPR (n->expr);
for (n = co->ext.omp_clauses->lists[OMP_LIST_LINEAR];
n; n = n->next)
WALK_SUBEXPR (n->expr);
for (n = co->ext.omp_clauses->lists[OMP_LIST_DEPEND_IN];
n; n = n->next)
WALK_SUBEXPR (n->expr);
for (n = co->ext.omp_clauses->lists[OMP_LIST_DEPEND_OUT];
n; n = n->next)
WALK_SUBEXPR (n->expr);
}
break;
default:
break;

89
gcc/fortran/gfortran.h
View File

@ -211,8 +211,12 @@ typedef enum
ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL,
ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE
ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_OMP_CANCEL, ST_OMP_CANCELLATION_POINT,
ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, ST_OMP_SIMD, ST_OMP_END_SIMD,
ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD,
ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_PROCEDURE, ST_GENERIC,
ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK,
ST_UNLOCK, ST_NONE
}
gfc_statement;
@ -1033,6 +1037,19 @@ gfc_namelist;
#define gfc_get_namelist() XCNEW (gfc_namelist)
/* For use in OpenMP clauses in case we need extra information
(aligned clause alignment, linear clause step, etc.). */
typedef struct gfc_omp_namelist
{
struct gfc_symbol *sym;
struct gfc_expr *expr;
struct gfc_omp_namelist *next;
}
gfc_omp_namelist;
#define gfc_get_omp_namelist() XCNEW (gfc_omp_namelist)
enum
{
OMP_LIST_PRIVATE,
@ -1041,6 +1058,11 @@ enum
OMP_LIST_COPYPRIVATE,
OMP_LIST_SHARED,
OMP_LIST_COPYIN,
OMP_LIST_UNIFORM,
OMP_LIST_ALIGNED,
OMP_LIST_LINEAR,
OMP_LIST_DEPEND_IN,
OMP_LIST_DEPEND_OUT,
OMP_LIST_PLUS,
OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
OMP_LIST_MULT,
@ -1080,23 +1102,60 @@ enum gfc_omp_default_sharing
OMP_DEFAULT_FIRSTPRIVATE
};
enum gfc_omp_proc_bind_kind
{
OMP_PROC_BIND_UNKNOWN,
OMP_PROC_BIND_MASTER,
OMP_PROC_BIND_SPREAD,
OMP_PROC_BIND_CLOSE
};
enum gfc_omp_cancel_kind
{
OMP_CANCEL_UNKNOWN,
OMP_CANCEL_PARALLEL,
OMP_CANCEL_SECTIONS,
OMP_CANCEL_DO,
OMP_CANCEL_TASKGROUP
};
typedef struct gfc_omp_clauses
{
struct gfc_expr *if_expr;
struct gfc_expr *final_expr;
struct gfc_expr *num_threads;
gfc_namelist *lists[OMP_LIST_NUM];
gfc_omp_namelist *lists[OMP_LIST_NUM];
enum gfc_omp_sched_kind sched_kind;
struct gfc_expr *chunk_size;
enum gfc_omp_default_sharing default_sharing;
int collapse;
bool nowait, ordered, untied, mergeable;
bool inbranch, notinbranch;
enum gfc_omp_cancel_kind cancel;
enum gfc_omp_proc_bind_kind proc_bind;
struct gfc_expr *safelen_expr;
struct gfc_expr *simdlen_expr;
}
gfc_omp_clauses;
#define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
/* Node in the linked list used for storing !$omp declare simd constructs. */
typedef struct gfc_omp_declare_simd
{
struct gfc_omp_declare_simd *next;
locus where; /* Where the !$omp declare simd construct occurred. */
gfc_symbol *proc_name;
gfc_omp_clauses *clauses;
}
gfc_omp_declare_simd;
#define gfc_get_omp_declare_simd() XCNEW (gfc_omp_declare_simd)
/* The gfc_st_label structure is a BBT attached to a namespace that
records the usage of statement labels within that space. */
@ -1469,6 +1528,9 @@ typedef struct gfc_namespace
/* A list of USE statements in this namespace. */
gfc_use_list *use_stmts;
/* Linked list of !$omp declare simd constructs. */
struct gfc_omp_declare_simd *omp_declare_simd;
/* Set to 1 if namespace is a BLOCK DATA program unit. */
unsigned is_block_data:1;
@ -2116,16 +2178,21 @@ typedef enum
EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT,
EXEC_OMP_TASKYIELD
EXEC_OMP_TASKYIELD, EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT,
EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD,
EXEC_OMP_PARALLEL_DO_SIMD
}
gfc_exec_op;
typedef enum
{
GFC_OMP_ATOMIC_UPDATE,
GFC_OMP_ATOMIC_READ,
GFC_OMP_ATOMIC_WRITE,
GFC_OMP_ATOMIC_CAPTURE
GFC_OMP_ATOMIC_UPDATE = 0,
GFC_OMP_ATOMIC_READ = 1,
GFC_OMP_ATOMIC_WRITE = 2,
GFC_OMP_ATOMIC_CAPTURE = 3,
GFC_OMP_ATOMIC_MASK = 3,
GFC_OMP_ATOMIC_SEQ_CST = 4,
GFC_OMP_ATOMIC_SWAP = 8
}
gfc_omp_atomic_op;
@ -2177,7 +2244,7 @@ typedef struct gfc_code
gfc_entry_list *entry;
gfc_omp_clauses *omp_clauses;
const char *omp_name;
gfc_namelist *omp_namelist;
gfc_omp_namelist *omp_namelist;
bool omp_bool;
gfc_omp_atomic_op omp_atomic;
}
@ -2733,6 +2800,7 @@ void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
void gfc_free_omp_namelist (gfc_omp_namelist *);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);
@ -2744,10 +2812,13 @@ gfc_expr *gfc_get_parentheses (gfc_expr *);
/* openmp.c */
struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
void gfc_free_omp_clauses (gfc_omp_clauses *);
void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *);
void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_declare_simd (gfc_namespace *);
void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
void gfc_omp_restore_state (struct gfc_omp_saved_state *);

21
gcc/fortran/match.c
View File

@ -2595,7 +2595,10 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
&& o != NULL
&& o->state == COMP_OMP_STRUCTURED_BLOCK
&& (o->head->op == EXEC_OMP_DO
|| o->head->op == EXEC_OMP_PARALLEL_DO))
|| o->head->op == EXEC_OMP_PARALLEL_DO
|| o->head->op == EXEC_OMP_SIMD
|| o->head->op == EXEC_OMP_DO_SIMD
|| o->head->op == EXEC_OMP_PARALLEL_DO_SIMD))
{
int collapse = 1;
gcc_assert (o->head->next != NULL
@ -4564,6 +4567,22 @@ gfc_free_namelist (gfc_namelist *name)
}
/* Free an OpenMP namelist structure. */
void
gfc_free_omp_namelist (gfc_omp_namelist *name)
{
gfc_omp_namelist *n;
for (; name; name = n)
{
gfc_free_expr (name->expr);
n = name->next;
free (name);
}
}
/* Match a NAMELIST statement. */
match

7
gcc/fortran/match.h
View File

@ -126,18 +126,25 @@ gfc_common_head *gfc_get_common (const char *, int);
match gfc_match_omp_eos (void);
match gfc_match_omp_atomic (void);
match gfc_match_omp_barrier (void);
match gfc_match_omp_cancel (void);
match gfc_match_omp_cancellation_point (void);
match gfc_match_omp_critical (void);
match gfc_match_omp_declare_simd (void);
match gfc_match_omp_do (void);
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_parallel (void);
match gfc_match_omp_parallel_do (void);
match gfc_match_omp_parallel_do_simd (void);
match gfc_match_omp_parallel_sections (void);
match gfc_match_omp_parallel_workshare (void);
match gfc_match_omp_sections (void);
match gfc_match_omp_simd (void);
match gfc_match_omp_single (void);
match gfc_match_omp_task (void);
match gfc_match_omp_taskgroup (void);
match gfc_match_omp_taskwait (void);
match gfc_match_omp_taskyield (void);
match gfc_match_omp_threadprivate (void);

110
gcc/fortran/module.c
View File

@ -3790,6 +3790,111 @@ mio_full_f2k_derived (gfc_symbol *sym)
mio_rparen ();
}
static const mstring omp_declare_simd_clauses[] =
{
minit ("INBRANCH", 0),
minit ("NOTINBRANCH", 1),
minit ("SIMDLEN", 2),
minit ("UNIFORM", 3),
minit ("LINEAR", 4),
minit ("ALIGNED", 5),
minit (NULL, -1)
};
/* Handle !$omp declare simd. */
static void
mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
{
if (iomode == IO_OUTPUT)
{
if (*odsp == NULL)
return;
}
else if (peek_atom () != ATOM_LPAREN)
return;
gfc_omp_declare_simd *ods = *odsp;
mio_lparen ();
if (iomode == IO_OUTPUT)
{
write_atom (ATOM_NAME, "OMP_DECLARE_SIMD");
if (ods->clauses)
{
gfc_omp_namelist *n;
if (ods->clauses->inbranch)
mio_name (0, omp_declare_simd_clauses);
if (ods->clauses->notinbranch)
mio_name (1, omp_declare_simd_clauses);
if (ods->clauses->simdlen_expr)
{
mio_name (2, omp_declare_simd_clauses);
mio_expr (&ods->clauses->simdlen_expr);
}
for (n = ods->clauses->lists[OMP_LIST_UNIFORM]; n; n = n->next)
{
mio_name (3, omp_declare_simd_clauses);
mio_symbol_ref (&n->sym);
}
for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next)
{
mio_name (4, omp_declare_simd_clauses);
mio_symbol_ref (&n->sym);
mio_expr (&n->expr);
}
for (n = ods->clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
{
mio_name (5, omp_declare_simd_clauses);
mio_symbol_ref (&n->sym);
mio_expr (&n->expr);
}
}
}
else
{
gfc_omp_namelist **ptrs[3] = { NULL, NULL, NULL };
require_atom (ATOM_NAME);
*odsp = ods = gfc_get_omp_declare_simd ();
ods->where = gfc_current_locus;
ods->proc_name = ns->proc_name;
if (peek_atom () == ATOM_NAME)
{
ods->clauses = gfc_get_omp_clauses ();
ptrs[0] = &ods->clauses->lists[OMP_LIST_UNIFORM];
ptrs[1] = &ods->clauses->lists[OMP_LIST_LINEAR];
ptrs[2] = &ods->clauses->lists[OMP_LIST_ALIGNED];
}
while (peek_atom () == ATOM_NAME)
{
gfc_omp_namelist *n;
int t = mio_name (0, omp_declare_simd_clauses);
switch (t)
{
case 0: ods->clauses->inbranch = true; break;
case 1: ods->clauses->notinbranch = true; break;
case 2: mio_expr (&ods->clauses->simdlen_expr); break;
case 3:
case 4:
case 5:
*ptrs[t - 3] = n = gfc_get_omp_namelist ();
ptrs[t - 3] = &n->next;
mio_symbol_ref (&n->sym);
if (t != 3)
mio_expr (&n->expr);
break;
}
}
}
mio_omp_declare_simd (ns, &ods->next);
mio_rparen ();
}
/* Unlike most other routines, the address of the symbol node is already
fixed on input and the name/module has already been filled in.
@ -3864,6 +3969,11 @@ mio_symbol (gfc_symbol *sym)
if (sym->attr.flavor == FL_DERIVED)
mio_integer (&(sym->hash_value));
if (sym->formal_ns
&& sym->formal_ns->proc_name == sym
&& sym->formal_ns->entries == NULL)
mio_omp_declare_simd (sym->formal_ns, &sym->formal_ns->omp_declare_simd);
mio_rparen ();
}

730
gcc/fortran/openmp.c
View File

File diff suppressed because it is too large Load Diff

84
gcc/fortran/parse.c
View File

@ -569,17 +569,27 @@ decode_omp_directive (void)
match ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
break;
case 'c':
match ("cancellation% point", gfc_match_omp_cancellation_point,
ST_OMP_CANCELLATION_POINT);
match ("cancel", gfc_match_omp_cancel, ST_OMP_CANCEL);
match ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL);
break;
case 'd':
match ("declare simd", gfc_match_omp_declare_simd,
ST_OMP_DECLARE_SIMD);
match ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD);
match ("do", gfc_match_omp_do, ST_OMP_DO);
break;
case 'e':
match ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC);
match ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL);
match ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD);
match ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
match ("end simd", gfc_match_omp_eos, ST_OMP_END_SIMD);
match ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER);
match ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED);
match ("end parallel do simd", gfc_match_omp_eos,
ST_OMP_END_PARALLEL_DO_SIMD);
match ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO);
match ("end parallel sections", gfc_match_omp_eos,
ST_OMP_END_PARALLEL_SECTIONS);
@ -588,6 +598,7 @@ decode_omp_directive (void)
match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL);
match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
match ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP);
match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK);
match ("end workshare", gfc_match_omp_end_nowait,
ST_OMP_END_WORKSHARE);
@ -602,6 +613,8 @@ decode_omp_directive (void)
match ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED);
break;
case 'p':
match ("parallel do simd", gfc_match_omp_parallel_do_simd,
ST_OMP_PARALLEL_DO_SIMD);
match ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
match ("parallel sections", gfc_match_omp_parallel_sections,
ST_OMP_PARALLEL_SECTIONS);
@ -612,12 +625,14 @@ decode_omp_directive (void)
case 's':
match ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
match ("section", gfc_match_omp_eos, ST_OMP_SECTION);
match ("simd", gfc_match_omp_simd, ST_OMP_SIMD);
match ("single", gfc_match_omp_single, ST_OMP_SINGLE);
break;
case 't':
match ("task", gfc_match_omp_task, ST_OMP_TASK);
match ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP);
match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT);
match ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD);
match ("task", gfc_match_omp_task, ST_OMP_TASK);
match ("threadprivate", gfc_match_omp_threadprivate,
ST_OMP_THREADPRIVATE);
break;
@ -1013,6 +1028,7 @@ next_statement (void)
case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
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_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \
case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK
@ -1026,14 +1042,15 @@ next_statement (void)
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
case ST_OMP_TASK: case ST_CRITICAL
case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \
case ST_OMP_DO_SIMD: case ST_OMP_PARALLEL_DO_SIMD: case ST_CRITICAL
/* Declaration statements */
#define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \
case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \
case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \
case ST_PROCEDURE
case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD
/* Block end statements. Errors associated with interchanging these
are detected in gfc_match_end(). */
@ -1524,12 +1541,24 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_BARRIER:
p = "!$OMP BARRIER";
break;
case ST_OMP_CANCEL:
p = "!$OMP CANCEL";
break;
case ST_OMP_CANCELLATION_POINT:
p = "!$OMP CANCELLATION POINT";
break;
case ST_OMP_CRITICAL:
p = "!$OMP CRITICAL";
break;
case ST_OMP_DECLARE_SIMD:
p = "!$OMP DECLARE SIMD";
break;
case ST_OMP_DO:
p = "!$OMP DO";
break;
case ST_OMP_DO_SIMD:
p = "!$OMP DO SIMD";
break;
case ST_OMP_END_ATOMIC:
p = "!$OMP END ATOMIC";
break;
@ -1539,6 +1568,12 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_END_DO:
p = "!$OMP END DO";
break;
case ST_OMP_END_DO_SIMD:
p = "!$OMP END DO SIMD";
break;
case ST_OMP_END_SIMD:
p = "!$OMP END SIMD";
break;
case ST_OMP_END_MASTER:
p = "!$OMP END MASTER";
break;
@ -1551,6 +1586,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_END_PARALLEL_DO:
p = "!$OMP END PARALLEL DO";
break;
case ST_OMP_END_PARALLEL_DO_SIMD:
p = "!$OMP END PARALLEL DO SIMD";
break;
case ST_OMP_END_PARALLEL_SECTIONS:
p = "!$OMP END PARALLEL SECTIONS";
break;
@ -1566,6 +1604,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_END_TASK:
p = "!$OMP END TASK";
break;
case ST_OMP_END_TASKGROUP:
p = "!$OMP END TASKGROUP";
break;
case ST_OMP_END_WORKSHARE:
p = "!$OMP END WORKSHARE";
break;
@ -1584,6 +1625,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_PARALLEL_DO:
p = "!$OMP PARALLEL DO";
break;
case ST_OMP_PARALLEL_DO_SIMD:
p = "!$OMP PARALLEL DO SIMD";
break;
case ST_OMP_PARALLEL_SECTIONS:
p = "!$OMP PARALLEL SECTIONS";
break;
@ -1596,12 +1640,18 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_SECTION:
p = "!$OMP SECTION";
break;
case ST_OMP_SIMD:
p = "!$OMP SIMD";
break;
case ST_OMP_SINGLE:
p = "!$OMP SINGLE";
break;
case ST_OMP_TASK:
p = "!$OMP TASK";
break;
case ST_OMP_TASKGROUP:
p = "!$OMP TASKGROUP";
break;
case ST_OMP_TASKWAIT:
p = "!$OMP TASKWAIT";
break;
@ -3578,7 +3628,19 @@ parse_omp_do (gfc_statement omp_st)
pop_state ();
st = next_statement ();
if (st == (omp_st == ST_OMP_DO ? ST_OMP_END_DO : ST_OMP_END_PARALLEL_DO))
gfc_statement omp_end_st = ST_OMP_END_DO;
switch (omp_st)
{
case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break;
case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break;
case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break;
case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break;
case ST_OMP_PARALLEL_DO_SIMD:
omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD;
break;
default: gcc_unreachable ();
}
if (st == omp_end_st)
{
if (new_st.op == EXEC_OMP_END_NOWAIT)
cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool;
@ -3610,7 +3672,8 @@ parse_omp_atomic (void)
np = new_level (cp);
np->op = cp->op;
np->block = NULL;
count = 1 + (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE);
count = 1 + ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
== GFC_OMP_ATOMIC_CAPTURE);
while (count)
{
@ -3636,7 +3699,8 @@ parse_omp_atomic (void)
gfc_warning_check ();
st = next_statement ();
}
else if (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE)
else if ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
== GFC_OMP_ATOMIC_CAPTURE)
gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C");
return st;
}
@ -3685,6 +3749,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_TASK:
omp_end_st = ST_OMP_END_TASK;
break;
case ST_OMP_TASKGROUP:
omp_end_st = ST_OMP_END_TASKGROUP;
break;
case ST_OMP_WORKSHARE:
omp_end_st = ST_OMP_END_WORKSHARE;
break;
@ -3744,6 +3811,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
break;
case ST_OMP_PARALLEL_DO:
case ST_OMP_PARALLEL_DO_SIMD:
st = parse_omp_do (st);
continue;
@ -3917,6 +3985,7 @@ parse_executable (gfc_statement st)
case ST_OMP_MASTER:
case ST_OMP_SINGLE:
case ST_OMP_TASK:
case ST_OMP_TASKGROUP:
parse_omp_structured_block (st, false);
break;
@ -3926,7 +3995,10 @@ parse_executable (gfc_statement st)
break;
case ST_OMP_DO:
case ST_OMP_DO_SIMD:
case ST_OMP_PARALLEL_DO:
case ST_OMP_PARALLEL_DO_SIMD:
case ST_OMP_SIMD:
st = parse_omp_do (st);
if (st == ST_IMPLIED_ENDDO)
return st;

15
gcc/fortran/resolve.c
View File

@ -9028,15 +9028,19 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_MASTER:
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_TASK:
case EXEC_OMP_TASKGROUP:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
case EXEC_OMP_WORKSHARE:
@ -9802,6 +9806,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
break;
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_TASK:
omp_workshare_save = omp_workshare_flag;
@ -9809,6 +9814,8 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
gfc_resolve_omp_parallel_blocks (code, ns);
break;
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_SIMD:
gfc_resolve_omp_do_blocks (code, ns);
break;
case EXEC_SELECT_TYPE:
@ -10128,13 +10135,18 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_FLUSH:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_MASTER:
case EXEC_OMP_ORDERED:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
case EXEC_OMP_TASKGROUP:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
case EXEC_OMP_WORKSHARE:
@ -10143,6 +10155,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
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_TASK:
@ -14681,6 +14694,8 @@ resolve_types (gfc_namespace *ns)
gfc_resolve_uops (ns->uop_root);
gfc_resolve_omp_declare_simd (ns);
gfc_current_ns = old_ns;
}

8
gcc/fortran/st.c
View File

@ -185,12 +185,17 @@ gfc_free_statement (gfc_code *p)
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
case EXEC_OMP_TASK:
case EXEC_OMP_WORKSHARE:
@ -203,7 +208,7 @@ gfc_free_statement (gfc_code *p)
break;
case EXEC_OMP_FLUSH:
gfc_free_namelist (p->ext.omp_namelist);
gfc_free_omp_namelist (p->ext.omp_namelist);
break;
case EXEC_OMP_ATOMIC:
@ -211,6 +216,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_MASTER:
case EXEC_OMP_ORDERED:
case EXEC_OMP_END_NOWAIT:
case EXEC_OMP_TASKGROUP:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
break;

1
gcc/fortran/symbol.c
View File

@ -3468,6 +3468,7 @@ gfc_free_namespace (gfc_namespace *ns)
free_tb_tree (ns->tb_sym_root);
free_tb_tree (ns->tb_uop_root);
gfc_free_finalizer_list (ns->finalizers);
gfc_free_omp_declare_simd_list (ns->omp_declare_simd);
gfc_free_charlen (ns->cl_list, NULL);
free_st_labels (ns->st_labels);

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

@ -1850,6 +1850,11 @@ module_sym:
if (DECL_CONTEXT (fndecl) == NULL_TREE)
pushdecl_top_level (fndecl);
if (sym->formal_ns
&& sym->formal_ns->proc_name == sym
&& sym->formal_ns->omp_declare_simd)
gfc_trans_omp_declare_simd (sym->formal_ns);
return fndecl;
}
@ -2555,6 +2560,9 @@ gfc_create_function_decl (gfc_namespace * ns, bool global)
/* Now create the read argument list. */
create_function_arglist (ns->proc_name);
if (ns->omp_declare_simd)
gfc_trans_omp_declare_simd (ns);
}
/* Return the decl used to hold the function return value. If

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

@ -427,8 +427,33 @@ gfc_trans_add_clause (tree node, tree tail)
}
static tree
gfc_trans_omp_variable (gfc_symbol *sym)
gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd)
{
if (declare_simd)
{
int cnt = 0;
gfc_symbol *proc_sym;
gfc_formal_arglist *f;
gcc_assert (sym->attr.dummy);
proc_sym = sym->ns->proc_name;
if (proc_sym->attr.entry_master)
++cnt;
if (gfc_return_by_reference (proc_sym))
{
++cnt;
if (proc_sym->ts.type == BT_CHARACTER)
++cnt;
}
for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
if (f->sym == sym)
break;
else if (f->sym)
++cnt;
gcc_assert (f);
return build_int_cst (integer_type_node, cnt);
}
tree t = gfc_get_symbol_decl (sym);
tree parent_decl;
int parent_flag;
@ -442,7 +467,8 @@ gfc_trans_omp_variable (gfc_symbol *sym)
entry_master = sym->attr.result
&& sym->ns->proc_name->attr.entry_master
&& !gfc_return_by_reference (sym->ns->proc_name);
parent_decl = DECL_CONTEXT (current_function_decl);
parent_decl = current_function_decl
? DECL_CONTEXT (current_function_decl) : NULL_TREE;
if ((t == parent_decl && return_value)
|| (sym->ns && sym->ns->proc_name
@ -481,13 +507,14 @@ gfc_trans_omp_variable (gfc_symbol *sym)
}
static tree
gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist,
tree list)
gfc_trans_omp_variable_list (enum omp_clause_code code,
gfc_omp_namelist *namelist, tree list,
bool declare_simd)
{
for (; namelist != NULL; namelist = namelist->next)
if (namelist->sym->attr.referenced)
if (namelist->sym->attr.referenced || declare_simd)
{
tree t = gfc_trans_omp_variable (namelist->sym);
tree t = gfc_trans_omp_variable (namelist->sym, declare_simd);
if (t != error_mark_node)
{
tree node = build_omp_clause (input_location, code);
@ -745,13 +772,13 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
}
static tree
gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
enum tree_code reduction_code, locus where)
{
for (; namelist != NULL; namelist = namelist->next)
if (namelist->sym->attr.referenced)
{
tree t = gfc_trans_omp_variable (namelist->sym);
tree t = gfc_trans_omp_variable (namelist->sym, false);
if (t != error_mark_node)
{
tree node = build_omp_clause (where.lb->location,
@ -768,7 +795,7 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
locus where, bool declare_simd = false)
{
tree omp_clauses = NULL_TREE, chunk_size, c;
int list;
@ -780,7 +807,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
for (list = 0; list < OMP_LIST_NUM; list++)
{
gfc_namelist *n = clauses->lists[list];
gfc_omp_namelist *n = clauses->lists[list];
if (n == NULL)
continue;
@ -853,10 +880,125 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
goto add_clause;
case OMP_LIST_COPYPRIVATE:
clause_code = OMP_CLAUSE_COPYPRIVATE;
goto add_clause;
case OMP_LIST_UNIFORM:
clause_code = OMP_CLAUSE_UNIFORM;
/* FALLTHROUGH */
add_clause:
omp_clauses
= gfc_trans_omp_variable_list (clause_code, n, omp_clauses);
= gfc_trans_omp_variable_list (clause_code, n, omp_clauses,
declare_simd);
break;
case OMP_LIST_ALIGNED:
for (; n != NULL; n = n->next)
if (n->sym->attr.referenced || declare_simd)
{
tree t = gfc_trans_omp_variable (n->sym, declare_simd);
if (t != error_mark_node)
{
tree node = build_omp_clause (input_location,
OMP_CLAUSE_ALIGNED);
OMP_CLAUSE_DECL (node) = t;
if (n->expr)
{
tree alignment_var;
if (block == NULL)
alignment_var = gfc_conv_constant_to_tree (n->expr);
else
{
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, n->expr);
gfc_add_block_to_block (block, &se.pre);
alignment_var = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
}
OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var;
}
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
}
break;
case OMP_LIST_LINEAR:
{
gfc_expr *last_step_expr = NULL;
tree last_step = NULL_TREE;
for (; n != NULL; n = n->next)
{
if (n->expr)
{
last_step_expr = n->expr;
last_step = NULL_TREE;
}
if (n->sym->attr.referenced || declare_simd)
{
tree t = gfc_trans_omp_variable (n->sym, declare_simd);
if (t != error_mark_node)
{
tree node = build_omp_clause (input_location,
OMP_CLAUSE_LINEAR);
OMP_CLAUSE_DECL (node) = t;
if (last_step_expr && last_step == NULL_TREE)
{
if (block == NULL)
last_step
= gfc_conv_constant_to_tree (last_step_expr);
else
{
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, last_step_expr);
gfc_add_block_to_block (block, &se.pre);
last_step = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
}
}
OMP_CLAUSE_LINEAR_STEP (node) = last_step;
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
}
}
}
break;
case OMP_LIST_DEPEND_IN:
case OMP_LIST_DEPEND_OUT:
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.referenced)
continue;
tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
OMP_CLAUSE_DECL (node) = gfc_get_symbol_decl (n->sym);
if (DECL_P (OMP_CLAUSE_DECL (node)))
TREE_ADDRESSABLE (OMP_CLAUSE_DECL (node)) = 1;
}
else
{
tree ptr;
gfc_init_se (&se, NULL);
if (n->expr->ref->u.ar.type == AR_ELEMENT)
{
gfc_conv_expr_reference (&se, n->expr);
ptr = se.expr;
}
else
{
gfc_conv_expr_descriptor (&se, n->expr);
ptr = gfc_conv_array_data (se.expr);
}
gfc_add_block_to_block (block, &se.pre);
gfc_add_block_to_block (block, &se.post);
OMP_CLAUSE_DECL (node)
= fold_build1_loc (input_location, INDIRECT_REF,
TREE_TYPE (TREE_TYPE (ptr)), ptr);
}
OMP_CLAUSE_DEPEND_KIND (node)
= ((list == OMP_LIST_DEPEND_IN)
? OMP_CLAUSE_DEPEND_IN : OMP_CLAUSE_DEPEND_OUT);
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
break;
default:
break;
@ -1000,6 +1142,83 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->inbranch)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->notinbranch)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
switch (clauses->cancel)
{
case OMP_CANCEL_UNKNOWN:
break;
case OMP_CANCEL_PARALLEL:
c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
break;
case OMP_CANCEL_SECTIONS:
c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
break;
case OMP_CANCEL_DO:
c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
break;
case OMP_CANCEL_TASKGROUP:
c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
break;
}
if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND);
switch (clauses->proc_bind)
{
case OMP_PROC_BIND_MASTER:
OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER;
break;
case OMP_PROC_BIND_SPREAD:
OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD;
break;
case OMP_PROC_BIND_CLOSE:
OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE;
break;
default:
gcc_unreachable ();
}
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->safelen_expr)
{
tree safelen_var;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, clauses->safelen_expr);
gfc_add_block_to_block (block, &se.pre);
safelen_var = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN);
OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->simdlen_expr)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN);
OMP_CLAUSE_SIMDLEN_EXPR (c)
= gfc_conv_constant_to_tree (clauses->simdlen_expr);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
return omp_clauses;
}
@ -1045,6 +1264,7 @@ gfc_trans_omp_atomic (gfc_code *code)
enum tree_code op = ERROR_MARK;
enum tree_code aop = OMP_ATOMIC;
bool var_on_left = false;
bool seq_cst = (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) != 0;
code = code->block->next;
gcc_assert (code->op == EXEC_ASSIGN);
@ -1060,7 +1280,7 @@ gfc_trans_omp_atomic (gfc_code *code)
&& expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
expr2 = expr2->value.function.actual->expr;
switch (atomic_code->ext.omp_atomic)
switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
{
case GFC_OMP_ATOMIC_READ:
gfc_conv_expr (&vse, code->expr1);
@ -1072,6 +1292,7 @@ gfc_trans_omp_atomic (gfc_code *code)
lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
x = build1 (OMP_ATOMIC_READ, type, lhsaddr);
OMP_ATOMIC_SEQ_CST (x) = seq_cst;
x = convert (TREE_TYPE (vse.expr), x);
gfc_add_modify (&block, vse.expr, x);
@ -1107,7 +1328,9 @@ gfc_trans_omp_atomic (gfc_code *code)
type = TREE_TYPE (lse.expr);
lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
== GFC_OMP_ATOMIC_WRITE)
|| (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP))
{
gfc_conv_expr (&rse, expr2);
gfc_add_block_to_block (&block, &rse.pre);
@ -1229,7 +1452,9 @@ gfc_trans_omp_atomic (gfc_code *code)
lhsaddr = save_expr (lhsaddr);
rhs = gfc_evaluate_now (rse.expr, &block);
if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
== GFC_OMP_ATOMIC_WRITE)
|| (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP))
x = rhs;
else
{
@ -1252,6 +1477,7 @@ gfc_trans_omp_atomic (gfc_code *code)
if (aop == OMP_ATOMIC)
{
x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
OMP_ATOMIC_SEQ_CST (x) = seq_cst;
gfc_add_expr_to_block (&block, x);
}
else
@ -1273,6 +1499,7 @@ gfc_trans_omp_atomic (gfc_code *code)
gfc_add_block_to_block (&block, &lse.pre);
}
x = build2 (aop, type, lhsaddr, convert (type, x));
OMP_ATOMIC_SEQ_CST (x) = seq_cst;
x = convert (TREE_TYPE (vse.expr), x);
gfc_add_modify (&block, vse.expr, x);
}
@ -1287,6 +1514,63 @@ gfc_trans_omp_barrier (void)
return build_call_expr_loc (input_location, decl, 0);
}
static tree
gfc_trans_omp_cancel (gfc_code *code)
{
int mask = 0;
tree ifc = boolean_true_node;
stmtblock_t block;
switch (code->ext.omp_clauses->cancel)
{
case OMP_CANCEL_PARALLEL: mask = 1; break;
case OMP_CANCEL_DO: mask = 2; break;
case OMP_CANCEL_SECTIONS: mask = 4; break;
case OMP_CANCEL_TASKGROUP: mask = 8; break;
default: gcc_unreachable ();
}
gfc_start_block (&block);
if (code->ext.omp_clauses->if_expr)
{
gfc_se se;
tree if_var;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, code->ext.omp_clauses->if_expr);
gfc_add_block_to_block (&block, &se.pre);
if_var = gfc_evaluate_now (se.expr, &block);
gfc_add_block_to_block (&block, &se.post);
tree type = TREE_TYPE (if_var);
ifc = fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, if_var,
build_zero_cst (type));
}
tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL);
tree c_bool_type = TREE_TYPE (TREE_TYPE (decl));
ifc = fold_convert (c_bool_type, ifc);
gfc_add_expr_to_block (&block,
build_call_expr_loc (input_location, decl, 2,
build_int_cst (integer_type_node,
mask), ifc));
return gfc_finish_block (&block);
}
static tree
gfc_trans_omp_cancellation_point (gfc_code *code)
{
int mask = 0;
switch (code->ext.omp_clauses->cancel)
{
case OMP_CANCEL_PARALLEL: mask = 1; break;
case OMP_CANCEL_DO: mask = 2; break;
case OMP_CANCEL_SECTIONS: mask = 4; break;
case OMP_CANCEL_TASKGROUP: mask = 8; break;
default: gcc_unreachable ();
}
tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT);
return build_call_expr_loc (input_location, decl, 1,
build_int_cst (integer_type_node, mask));
}
static tree
gfc_trans_omp_critical (gfc_code *code)
{
@ -1304,7 +1588,7 @@ typedef struct dovar_init_d {
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
gfc_omp_clauses *do_clauses, tree par_clauses)
{
gfc_se se;
@ -1344,14 +1628,15 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
if (clauses)
{
gfc_namelist *n;
for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL;
n = n->next)
gfc_omp_namelist *n;
for (n = clauses->lists[(op == EXEC_OMP_SIMD && collapse == 1)
? OMP_LIST_LINEAR : OMP_LIST_LASTPRIVATE];
n != NULL; n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
break;
if (n != NULL)
dovar_found = 1;
else if (n == NULL)
else if (n == NULL && op != EXEC_OMP_SIMD)
for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
break;
@ -1393,7 +1678,8 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
}
else
dovar_decl
= gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym);
= gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym,
false);
/* Loop body. */
if (simple)
@ -1447,11 +1733,24 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
if (!dovar_found)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
if (op == EXEC_OMP_SIMD)
{
if (collapse == 1)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
OMP_CLAUSE_LINEAR_STEP (tmp) = step;
}
else
tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
if (!simple)
dovar_found = 2;
}
else
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
OMP_CLAUSE_DECL (tmp) = dovar_decl;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
else if (dovar_found == 2)
if (dovar_found == 2)
{
tree c = NULL;
@ -1475,8 +1774,14 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
break;
}
else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR
&& OMP_CLAUSE_DECL (c) == dovar_decl)
{
OMP_CLAUSE_LINEAR_STMT (c) = tmp;
break;
}
}
if (c == NULL && par_clauses != NULL)
if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL)
{
for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
@ -1496,7 +1801,17 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
}
if (!simple)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
if (op != EXEC_OMP_SIMD)
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
else if (collapse == 1)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
OMP_CLAUSE_LINEAR_STEP (tmp) = step;
OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1;
}
else
tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
OMP_CLAUSE_DECL (tmp) = count;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
@ -1538,7 +1853,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
}
/* End of loop body. */
stmt = make_node (OMP_FOR);
stmt = make_node (op == EXEC_OMP_SIMD ? OMP_SIMD : OMP_FOR);
TREE_TYPE (stmt) = void_type_node;
OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
@ -1589,37 +1904,219 @@ gfc_trans_omp_parallel (gfc_code *code)
return gfc_finish_block (&block);
}
enum
{
GFC_OMP_SPLIT_SIMD,
GFC_OMP_SPLIT_DO,
GFC_OMP_SPLIT_PARALLEL,
GFC_OMP_SPLIT_NUM
};
enum
{
GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD),
GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO),
GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL)
};
static void
gfc_split_omp_clauses (gfc_code *code,
gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
{
int mask = 0, innermost = 0, i;
memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses));
switch (code->op)
{
case EXEC_OMP_DO_SIMD:
mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
innermost = GFC_OMP_SPLIT_SIMD;
break;
case EXEC_OMP_PARALLEL_DO:
mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
innermost = GFC_OMP_SPLIT_DO;
break;
case EXEC_OMP_PARALLEL_DO_SIMD:
mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
innermost = GFC_OMP_SPLIT_SIMD;
break;
default:
gcc_unreachable ();
}
if (code->ext.omp_clauses != NULL)
{
if (mask & GFC_OMP_MASK_PARALLEL)
{
/* First the clauses that are unique to some constructs. */
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN]
= code->ext.omp_clauses->lists[OMP_LIST_COPYIN];
clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads
= code->ext.omp_clauses->num_threads;
clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind
= code->ext.omp_clauses->proc_bind;
/* Shared and default clauses are allowed on parallel and teams. */
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED]
= code->ext.omp_clauses->lists[OMP_LIST_SHARED];
clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing
= code->ext.omp_clauses->default_sharing;
/* FIXME: This is currently being discussed. */
clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
= code->ext.omp_clauses->if_expr;
}
if (mask & GFC_OMP_MASK_DO)
{
/* First the clauses that are unique to some constructs. */
clausesa[GFC_OMP_SPLIT_DO].ordered
= code->ext.omp_clauses->ordered;
clausesa[GFC_OMP_SPLIT_DO].sched_kind
= code->ext.omp_clauses->sched_kind;
clausesa[GFC_OMP_SPLIT_DO].chunk_size
= code->ext.omp_clauses->chunk_size;
clausesa[GFC_OMP_SPLIT_DO].nowait
= code->ext.omp_clauses->nowait;
/* Duplicate collapse. */
clausesa[GFC_OMP_SPLIT_DO].collapse
= code->ext.omp_clauses->collapse;
}
if (mask & GFC_OMP_MASK_SIMD)
{
clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr
= code->ext.omp_clauses->safelen_expr;
clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LINEAR]
= code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED]
= code->ext.omp_clauses->lists[OMP_LIST_ALIGNED];
/* Duplicate collapse. */
clausesa[GFC_OMP_SPLIT_SIMD].collapse
= code->ext.omp_clauses->collapse;
}
/* Private clause is supported on all constructs but target,
it is enough to put it on the innermost one. For
!$ omp do put it on parallel though,
as that's what we did for OpenMP 3.1. */
clausesa[innermost == GFC_OMP_SPLIT_DO
? (int) GFC_OMP_SPLIT_PARALLEL
: innermost].lists[OMP_LIST_PRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
/* Firstprivate clause is supported on all constructs but
target and simd. Put it on the outermost of those and
duplicate on parallel. */
if (mask & GFC_OMP_MASK_PARALLEL)
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
else if (mask & GFC_OMP_MASK_DO)
clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
/* Lastprivate is allowed on do and simd. In
parallel do{, simd} we actually want to put it on
parallel rather than do. */
if (mask & GFC_OMP_MASK_PARALLEL)
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
else if (mask & GFC_OMP_MASK_DO)
clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
if (mask & GFC_OMP_MASK_SIMD)
clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
/* Reduction is allowed on simd, do, parallel and teams.
Duplicate it on all of them, but omit on do if
parallel is present. */
for (i = OMP_LIST_REDUCTION_FIRST; i <= OMP_LIST_REDUCTION_LAST; i++)
{
if (mask & GFC_OMP_MASK_PARALLEL)
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
= code->ext.omp_clauses->lists[i];
else if (mask & GFC_OMP_MASK_DO)
clausesa[GFC_OMP_SPLIT_DO].lists[i]
= code->ext.omp_clauses->lists[i];
if (mask & GFC_OMP_MASK_SIMD)
clausesa[GFC_OMP_SPLIT_SIMD].lists[i]
= code->ext.omp_clauses->lists[i];
}
}
if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
== (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
clausesa[GFC_OMP_SPLIT_DO].nowait = true;
}
static tree
gfc_trans_omp_do_simd (gfc_code *code, gfc_omp_clauses *clausesa,
tree omp_clauses)
{
stmtblock_t block, *pblock = NULL;
gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
tree stmt, body, omp_do_clauses = NULL_TREE;
gfc_start_block (&block);
if (clausesa == NULL)
{
clausesa = clausesa_buf;
gfc_split_omp_clauses (code, clausesa);
}
omp_do_clauses
= gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc);
pblock = &block;
body = gfc_trans_omp_do (code, EXEC_OMP_SIMD, pblock,
&clausesa[GFC_OMP_SPLIT_SIMD], omp_clauses);
if (TREE_CODE (body) != BIND_EXPR)
body = build3_v (BIND_EXPR, NULL, body, poplevel (1, 0));
else
poplevel (0, 0);
stmt = make_node (OMP_FOR);
TREE_TYPE (stmt) = void_type_node;
OMP_FOR_BODY (stmt) = body;
OMP_FOR_CLAUSES (stmt) = omp_do_clauses;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
static tree
gfc_trans_omp_parallel_do (gfc_code *code)
{
stmtblock_t block, *pblock = NULL;
gfc_omp_clauses parallel_clauses, do_clauses;
gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
tree stmt, omp_clauses = NULL_TREE;
gfc_start_block (&block);
memset (&do_clauses, 0, sizeof (do_clauses));
if (code->ext.omp_clauses != NULL)
{
memcpy (&parallel_clauses, code->ext.omp_clauses,
sizeof (parallel_clauses));
do_clauses.sched_kind = parallel_clauses.sched_kind;
do_clauses.chunk_size = parallel_clauses.chunk_size;
do_clauses.ordered = parallel_clauses.ordered;
do_clauses.collapse = parallel_clauses.collapse;
parallel_clauses.sched_kind = OMP_SCHED_NONE;
parallel_clauses.chunk_size = NULL;
parallel_clauses.ordered = false;
parallel_clauses.collapse = 0;
omp_clauses = gfc_trans_omp_clauses (&block, &parallel_clauses,
code->loc);
}
do_clauses.nowait = true;
if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
gfc_split_omp_clauses (code, clausesa);
omp_clauses
= gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
code->loc);
if (!clausesa[GFC_OMP_SPLIT_DO].ordered
&& clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC)
pblock = &block;
else
pushlevel ();
stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses);
stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, pblock,
&clausesa[GFC_OMP_SPLIT_DO], omp_clauses);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
else
poplevel (0, 0);
stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
omp_clauses);
OMP_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
static tree
gfc_trans_omp_parallel_do_simd (gfc_code *code)
{
stmtblock_t block;
gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
tree stmt, omp_clauses = NULL_TREE;
gfc_start_block (&block);
gfc_split_omp_clauses (code, clausesa);
omp_clauses
= gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
code->loc);
pushlevel ();
stmt = gfc_trans_omp_do_simd (code, clausesa, omp_clauses);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
else
@ -1742,6 +2239,13 @@ gfc_trans_omp_task (gfc_code *code)
return gfc_finish_block (&block);
}
static tree
gfc_trans_omp_taskgroup (gfc_code *code)
{
tree stmt = gfc_trans_code (code->block->next);
return build1_loc (input_location, OMP_TASKGROUP, void_type_node, stmt);
}
static tree
gfc_trans_omp_taskwait (void)
{
@ -1923,10 +2427,18 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_atomic (code);
case EXEC_OMP_BARRIER:
return gfc_trans_omp_barrier ();
case EXEC_OMP_CANCEL:
return gfc_trans_omp_cancel (code);
case EXEC_OMP_CANCELLATION_POINT:
return gfc_trans_omp_cancellation_point (code);
case EXEC_OMP_CRITICAL:
return gfc_trans_omp_critical (code);
case EXEC_OMP_DO:
return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses, NULL);
case EXEC_OMP_SIMD:
return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
NULL);
case EXEC_OMP_DO_SIMD:
return gfc_trans_omp_do_simd (code, NULL, NULL_TREE);
case EXEC_OMP_FLUSH:
return gfc_trans_omp_flush ();
case EXEC_OMP_MASTER:
@ -1937,6 +2449,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_parallel (code);
case EXEC_OMP_PARALLEL_DO:
return gfc_trans_omp_parallel_do (code);
case EXEC_OMP_PARALLEL_DO_SIMD:
return gfc_trans_omp_parallel_do_simd (code);
case EXEC_OMP_PARALLEL_SECTIONS:
return gfc_trans_omp_parallel_sections (code);
case EXEC_OMP_PARALLEL_WORKSHARE:
@ -1947,6 +2461,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_single (code, code->ext.omp_clauses);
case EXEC_OMP_TASK:
return gfc_trans_omp_task (code);
case EXEC_OMP_TASKGROUP:
return gfc_trans_omp_taskgroup (code);
case EXEC_OMP_TASKWAIT:
return gfc_trans_omp_taskwait ();
case EXEC_OMP_TASKYIELD:
@ -1957,3 +2473,22 @@ gfc_trans_omp_directive (gfc_code *code)
gcc_unreachable ();
}
}
void
gfc_trans_omp_declare_simd (gfc_namespace *ns)
{
if (ns->entries)
return;
gfc_omp_declare_simd *ods;
for (ods = ns->omp_declare_simd; ods; ods = ods->next)
{
tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true);
tree fndecl = ns->proc_name->backend_decl;
if (c != NULL_TREE)
c = tree_cons (NULL_TREE, c, NULL_TREE);
c = build_tree_list (get_identifier ("omp declare simd"), c);
TREE_CHAIN (c) = DECL_ATTRIBUTES (fndecl);
DECL_ATTRIBUTES (fndecl) = c;
}
}

1
gcc/fortran/trans-stmt.h
View File

@ -63,6 +63,7 @@ tree gfc_trans_deallocate_array (tree);
/* trans-openmp.c */
tree gfc_trans_omp_directive (gfc_code *);
void gfc_trans_omp_declare_simd (gfc_namespace *);
/* trans-io.c */
tree gfc_trans_open (gfc_code *);

6
gcc/fortran/trans.c
View File

@ -1848,18 +1848,24 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_FLUSH:
case EXEC_OMP_MASTER:
case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_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_TASK:
case EXEC_OMP_TASKGROUP:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
case EXEC_OMP_WORKSHARE:

21
gcc/gimplify.c
View File

@ -6067,6 +6067,27 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
(gimple_seq_first_stmt (OMP_CLAUSE_LASTPRIVATE_GIMPLE_SEQ (c)));
OMP_CLAUSE_LASTPRIVATE_STMT (c) = NULL_TREE;
gimplify_omp_ctxp = outer_ctx;
}
else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR
&& OMP_CLAUSE_LINEAR_STMT (c))
{
gimplify_omp_ctxp = ctx;
push_gimplify_context ();
if (TREE_CODE (OMP_CLAUSE_LINEAR_STMT (c)) != BIND_EXPR)
{
tree bind = build3 (BIND_EXPR, void_type_node, NULL,
NULL, NULL);
TREE_SIDE_EFFECTS (bind) = 1;
BIND_EXPR_BODY (bind) = OMP_CLAUSE_LINEAR_STMT (c);
OMP_CLAUSE_LINEAR_STMT (c) = bind;
}
gimplify_and_add (OMP_CLAUSE_LINEAR_STMT (c),
&OMP_CLAUSE_LINEAR_GIMPLE_SEQ (c));
pop_gimplify_context
(gimple_seq_first_stmt (OMP_CLAUSE_LINEAR_GIMPLE_SEQ (c)));
OMP_CLAUSE_LINEAR_STMT (c) = NULL_TREE;
gimplify_omp_ctxp = outer_ctx;
}
if (notice_outer)

20
gcc/omp-low.c
View File

@ -3405,8 +3405,8 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist,
= gimple_build_assign (unshare_expr (lvar), iv);
gsi_insert_before_without_update (&gsi, g,
GSI_SAME_STMT);
tree stept = POINTER_TYPE_P (TREE_TYPE (x))
? sizetype : TREE_TYPE (x);
tree stept = POINTER_TYPE_P (TREE_TYPE (iv))
? sizetype : TREE_TYPE (iv);
tree t = fold_convert (stept,
OMP_CLAUSE_LINEAR_STEP (c));
enum tree_code code = PLUS_EXPR;
@ -8416,10 +8416,14 @@ maybe_add_implicit_barrier_cancel (omp_context *ctx, gimple_seq *body)
&& gimple_code (ctx->outer->stmt) == GIMPLE_OMP_PARALLEL
&& ctx->outer->cancellable)
{
tree lhs = create_tmp_var (boolean_type_node, NULL);
tree fndecl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL);
tree c_bool_type = TREE_TYPE (TREE_TYPE (fndecl));
tree lhs = create_tmp_var (c_bool_type, NULL);
gimple_omp_return_set_lhs (omp_return, lhs);
tree fallthru_label = create_artificial_label (UNKNOWN_LOCATION);
gimple g = gimple_build_cond (NE_EXPR, lhs, boolean_false_node,
gimple g = gimple_build_cond (NE_EXPR, lhs,
fold_convert (c_bool_type,
boolean_false_node),
ctx->outer->cancel_label, fallthru_label);
gimple_seq_add_stmt (body, g);
gimple_seq_add_stmt (body, gimple_build_label (fallthru_label));
@ -10125,21 +10129,23 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx)
}
break;
}
tree lhs;
lhs = create_tmp_var (boolean_type_node, NULL);
if (DECL_FUNCTION_CODE (fndecl) == BUILT_IN_GOMP_BARRIER)
{
fndecl = builtin_decl_explicit (BUILT_IN_GOMP_BARRIER_CANCEL);
gimple_call_set_fndecl (stmt, fndecl);
gimple_call_set_fntype (stmt, TREE_TYPE (fndecl));
}
tree lhs;
lhs = create_tmp_var (TREE_TYPE (TREE_TYPE (fndecl)), NULL);
gimple_call_set_lhs (stmt, lhs);
tree fallthru_label;
fallthru_label = create_artificial_label (UNKNOWN_LOCATION);
gimple g;
g = gimple_build_label (fallthru_label);
gsi_insert_after (gsi_p, g, GSI_SAME_STMT);
g = gimple_build_cond (NE_EXPR, lhs, boolean_false_node,
g = gimple_build_cond (NE_EXPR, lhs,
fold_convert (TREE_TYPE (lhs),
boolean_false_node),
cctx->cancel_label, fallthru_label);
gsi_insert_after (gsi_p, g, GSI_SAME_STMT);
break;

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2014-05-11 Jakub Jelinek <jakub@redhat.com>
* gfortran.dg/gomp/affinity-1.f90: New test.
2014-05-11 Richard Sandiford <rdsandiford@googlemail.com>
* gcc.dg/torture/pr61136.c: New test.

19
gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 Normal file
View File

@ -0,0 +1,19 @@
integer :: i, j
integer, dimension (10, 10) :: a
!$omp parallel do default(none)proc_bind(master)shared(a)
do i = 1, 10
j = 4
do j = 1, 10
a(i, j) = i + j
end do
j = 8
end do
!$omp end parallel do
!$omp parallel proc_bind (close)
!$omp parallel default(none) proc_bind (spread) firstprivate(a) private (i)
do i = 1, 10
a(i, i) = i
enddo
!$omp end parallel
!$omp endparallel
end

2
gcc/tree-nested.c
View File

@ -1112,6 +1112,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_DEPEND:
wi->val_only = true;
wi->is_lhs = false;
convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
@ -1651,6 +1652,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_DEPEND:
wi->val_only = true;
wi->is_lhs = false;
convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), &dummy,

9
gcc/tree.c
View File

@ -253,7 +253,7 @@ unsigned const char omp_clause_num_ops[] =
4, /* OMP_CLAUSE_REDUCTION */
1, /* OMP_CLAUSE_COPYIN */
1, /* OMP_CLAUSE_COPYPRIVATE */
2, /* OMP_CLAUSE_LINEAR */
3, /* OMP_CLAUSE_LINEAR */
2, /* OMP_CLAUSE_ALIGNED */
1, /* OMP_CLAUSE_DEPEND */
1, /* OMP_CLAUSE_UNIFORM */
@ -10960,8 +10960,13 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp));
}
case OMP_CLAUSE_ALIGNED:
case OMP_CLAUSE_LINEAR:
WALK_SUBTREE (OMP_CLAUSE_DECL (*tp));
WALK_SUBTREE (OMP_CLAUSE_LINEAR_STEP (*tp));
WALK_SUBTREE (OMP_CLAUSE_LINEAR_STMT (*tp));
WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp));
case OMP_CLAUSE_ALIGNED:
case OMP_CLAUSE_FROM:
case OMP_CLAUSE_TO:
case OMP_CLAUSE_MAP:

3
gcc/tree.h
View File

@ -1333,6 +1333,9 @@ extern void protected_set_expr_location (tree, location_t);
#define OMP_CLAUSE_LINEAR_STEP(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR), 1)
#define OMP_CLAUSE_LINEAR_STMT(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR), 2)
#define OMP_CLAUSE_LINEAR_GIMPLE_SEQ(NODE) \
(OMP_CLAUSE_CHECK (NODE))->omp_clause.gimple_reduction_init

20
libgomp/ChangeLog
View File

@ -1,3 +1,23 @@
2014-05-11 Jakub Jelinek <jakub@redhat.com>
* testsuite/libgomp.fortran/cancel-do-1.f90: New test.
* testsuite/libgomp.fortran/cancel-do-2.f90: New test.
* testsuite/libgomp.fortran/cancel-parallel-1.f90: New test.
* testsuite/libgomp.fortran/cancel-parallel-3.f90: New test.
* testsuite/libgomp.fortran/cancel-sections-1.f90: New test.
* testsuite/libgomp.fortran/cancel-taskgroup-2.f90: New test.
* testsuite/libgomp.fortran/declare-simd-1.f90: New test.
* testsuite/libgomp.fortran/declare-simd-2.f90: New test.
* testsuite/libgomp.fortran/declare-simd-3.f90: New test.
* testsuite/libgomp.fortran/depend-1.f90: New test.
* testsuite/libgomp.fortran/depend-2.f90: New test.
* testsuite/libgomp.fortran/omp_atomic5.f90: New test.
* testsuite/libgomp.fortran/simd1.f90: New test.
* testsuite/libgomp.fortran/simd2.f90: New test.
* testsuite/libgomp.fortran/simd3.f90: New test.
* testsuite/libgomp.fortran/simd4.f90: New test.
* testsuite/libgomp.fortran/taskgroup1.f90: New test.
2014-05-02 Jakub Jelinek <jakub@redhat.com>
* testsuite/libgomp.c/simd-10.c: New test.

14
libgomp/testsuite/libgomp.fortran/cancel-do-1.f90 Normal file
View File

@ -0,0 +1,14 @@
! { dg-do run }
! { dg-set-target-env-var OMP_CANCELLATION "true" }
use omp_lib
integer :: i
!$omp parallel num_threads(32)
!$omp do
do i = 0, 999
!$omp cancel do
if (omp_get_cancellation ()) call abort
enddo
!$omp endparallel
end

90
libgomp/testsuite/libgomp.fortran/cancel-do-2.f90 Normal file
View File

@ -0,0 +1,90 @@
! { dg-do run }
! { dg-options "-fno-inline -fno-ipa-sra -fno-ipa-cp -fno-ipa-cp-clone" }
! { dg-set-target-env-var OMP_CANCELLATION "true" }
use omp_lib
integer :: i
logical :: x(5)
x(:) = .false.
x(1) = .true.
x(3) = .true.
if (omp_get_cancellation ()) call foo (x)
contains
subroutine foo (x)
use omp_lib
logical :: x(5)
integer :: v, w, i
v = 0
w = 0
!$omp parallel num_threads (32) shared (v, w)
!$omp do
do i = 0, 999
!$omp cancel do if (x(1))
call abort
end do
!$omp do
do i = 0, 999
!$omp cancel do if (x(2))
!$omp atomic
v = v + 1
!$omp endatomic
enddo
!$omp do
do i = 0, 999
!$omp cancel do if (x(3))
!$omp atomic
w = w + 8
!$omp end atomic
end do
!$omp do
do i = 0, 999
!$omp cancel do if (x(4))
!$omp atomic
v = v + 2
!$omp end atomic
end do
!$omp end do
!$omp end parallel
if (v.ne.3000.or.w.ne.0) call abort
!$omp parallel num_threads (32) shared (v, w)
! None of these cancel directives should actually cancel anything,
! but the compiler shouldn't know that and thus should use cancellable
! barriers at the end of all the workshares.
!$omp cancel parallel if (omp_get_thread_num ().eq.1.and.x(5))
!$omp do
do i = 0, 999
!$omp cancel do if (x(1))
call abort
end do
!$omp cancel parallel if (omp_get_thread_num ().eq.2.and.x(5))
!$omp do
do i = 0, 999
!$omp cancel do if (x(2))
!$omp atomic
v = v + 1
!$omp endatomic
enddo
!$omp cancel parallel if (omp_get_thread_num ().eq.3.and.x(5))
!$omp do
do i = 0, 999
!$omp cancel do if (x(3))
!$omp atomic
w = w + 8
!$omp end atomic
end do
!$omp cancel parallel if (omp_get_thread_num ().eq.4.and.x(5))
!$omp do
do i = 0, 999
!$omp cancel do if (x(4))
!$omp atomic
v = v + 2
!$omp end atomic
end do
!$omp end do
!$omp cancel parallel if (omp_get_thread_num ().eq.5.and.x(5))
!$omp end parallel
if (v.ne.6000.or.w.ne.0) call abort
end subroutine
end

10
libgomp/testsuite/libgomp.fortran/cancel-parallel-1.f90 Normal file
View File

@ -0,0 +1,10 @@
! { dg-do run }
! { dg-set-target-env-var OMP_CANCELLATION "true" }
use omp_lib
!$omp parallel num_threads(32)
!$omp cancel parallel
if (omp_get_cancellation ()) call abort
!$omp end parallel
end

38
libgomp/testsuite/libgomp.fortran/cancel-parallel-3.f90 Normal file
View File

@ -0,0 +1,38 @@
! { dg-do run }
! { dg-options "-fno-inline -fno-ipa-sra -fno-ipa-cp -fno-ipa-cp-clone" }
! { dg-set-target-env-var OMP_CANCELLATION "true" }
use omp_lib
integer :: x, i, j
common /x/ x
call omp_set_dynamic (.false.)
call omp_set_schedule (omp_sched_static, 1)
!$omp parallel num_threads(16) private (i, j)
call do_some_work
!$omp barrier
if (omp_get_thread_num ().eq.1) then
call sleep (2)
!$omp cancellation point parallel
end if
do j = 3, 16
!$omp do schedule(runtime)
do i = 0, j - 1
call do_some_work
end do
!$omp enddo nowait
end do
if (omp_get_thread_num ().eq.0) then
call sleep (1)
!$omp cancel parallel
end if
!$omp end parallel
contains
subroutine do_some_work
integer :: x
common /x/ x
!$omp atomic
x = x + 1
!$omp end atomic
endsubroutine do_some_work
end

23
libgomp/testsuite/libgomp.fortran/cancel-sections-1.f90 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do run }
! { dg-set-target-env-var OMP_CANCELLATION "true" }
use omp_lib
if (omp_get_cancellation ()) then
!$omp parallel num_threads(32)
!$omp sections
!$omp cancel sections
call abort
!$omp section
!$omp cancel sections
call abort
!$omp section
!$omp cancel sections
call abort
!$omp section
!$omp cancel sections
call abort
!$omp end sections
!$omp end parallel
end if
end

28
libgomp/testsuite/libgomp.fortran/cancel-taskgroup-2.f90 Normal file
View File

@ -0,0 +1,28 @@
! { dg-do run }
! { dg-set-target-env-var OMP_CANCELLATION "true" }
use omp_lib
integer :: i
!$omp parallel
!$omp taskgroup
!$omp task
!$omp cancel taskgroup
call abort
!$omp endtask
!$omp endtaskgroup
!$omp endparallel
!$omp parallel private (i)
!$omp barrier
!$omp single
!$omp taskgroup
do i = 0, 49
!$omp task
!$omp cancellation point taskgroup
!$omp cancel taskgroup if (i.gt.5)
!$omp end task
end do
!$omp end taskgroup
!$omp endsingle
!$omp end parallel
end

92
libgomp/testsuite/libgomp.fortran/declare-simd-1.f90 Normal file
View File

@ -0,0 +1,92 @@
! { dg-options "-fno-inline" }
! { dg-additional-options "-msse2" { target sse2_runtime } }
! { dg-additional-options "-mavx" { target avx_runtime } }
module declare_simd_1_mod
contains
real function foo (a, b, c)
!$omp declare simd (foo) simdlen (4) uniform (a) linear (b : 5)
double precision, value :: a
real, value :: c
!$omp declare simd (foo)
integer, value :: b
foo = a + b * c
end function foo
end module declare_simd_1_mod
use declare_simd_1_mod
interface
function bar (a, b, c)
!$omp declare simd (bar)
integer, value :: b
real, value :: c
real :: bar
!$omp declare simd (bar) simdlen (4) linear (b : 2)
double precision, value :: a
end function bar
end interface
integer :: i
double precision :: a(128)
real :: b(128), d(128)
data d /171., 414., 745., 1164., 1671., 2266., 2949., 3720., 4579., &
& 5526., 6561., 7684., 8895., 10194., 11581., 13056., 14619., &
& 16270., 18009., 19836., 21751., 23754., 25845., 28024., &
& 30291., 32646., 35089., 37620., 40239., 42946., 45741., &
& 48624., 51595., 54654., 57801., 61036., 64359., 67770., &
& 71269., 74856., 78531., 82294., 86145., 90084., 94111., &
& 98226., 102429., 106720., 111099., 115566., 120121., 124764., &
& 129495., 134314., 139221., 144216., 149299., 154470., 159729., &
& 165076., 170511., 176034., 181645., 187344., 193131., 199006., &
& 204969., 211020., 217159., 223386., 229701., 236104., 242595., &
& 249174., 255841., 262596., 269439., 276370., 283389., 290496., &
& 297691., 304974., 312345., 319804., 327351., 334986., 342709., &
& 350520., 358419., 366406., 374481., 382644., 390895., 399234., &
& 407661., 416176., 424779., 433470., 442249., 451116., 460071., &
& 469114., 478245., 487464., 496771., 506166., 515649., 525220., &
& 534879., 544626., 554461., 564384., 574395., 584494., 594681., &
& 604956., 615319., 625770., 636309., 646936., 657651., 668454., &
& 679345., 690324., 701391., 712546., 723789., 735120./
!$omp simd
do i = 1, 128
a(i) = 7.0 * i + 16.0
b(i) = 5.0 * i + 12.0
end do
!$omp simd
do i = 1, 128
b(i) = foo (a(i), 3, b(i))
end do
!$omp simd
do i = 1, 128
b(i) = bar (a(i), 2 * i, b(i))
end do
if (any (b.ne.d)) call abort
!$omp simd
do i = 1, 128
b(i) = i * 2.0
end do
!$omp simd
do i = 1, 128
b(i) = baz (7.0_8, 2, b(i))
end do
do i = 1, 128
if (b(i).ne.(7.0 + 4.0 * i)) call abort
end do
contains
function baz (x, y, z)
!$omp declare simd (baz) simdlen (8) uniform (x, y)
!$omp declare simd (baz)
integer, value :: y
real, value :: z
real :: baz
double precision, value :: x
baz = x + y * z
end function baz
end
function bar (a, b, c)
integer, value :: b
real, value :: c
real :: bar
double precision, value :: a
!$omp declare simd (bar)
!$omp declare simd (bar) simdlen (4) linear (b : 2)
bar = a + b * c
end function bar

25
libgomp/testsuite/libgomp.fortran/declare-simd-2.f90 Normal file
View File

@ -0,0 +1,25 @@
! { dg-do run }
! { dg-options "-fno-inline" }
! { dg-additional-sources declare-simd-3.f90 }
! { dg-additional-options "-msse2" { target sse2_runtime } }
! { dg-additional-options "-mavx" { target avx_runtime } }
module declare_simd_2_mod
contains
real function foo (a, b, c)
!$omp declare simd (foo) simdlen (4) uniform (a) linear (b : 5)
double precision, value :: a
real, value :: c
!$omp declare simd (foo)
integer, value :: b
foo = a + b * c
end function foo
end module declare_simd_2_mod
interface
subroutine bar ()
end subroutine bar
end interface
call bar ()
end

22
libgomp/testsuite/libgomp.fortran/declare-simd-3.f90 Normal file
View File

@ -0,0 +1,22 @@
! Don't compile this anywhere, it is just auxiliary
! file compiled together with declare-simd-2.f90
! to verify inter-CU module handling of omp declare simd.
! { dg-do compile { target { lp64 && { ! lp64 } } } }
subroutine bar
use declare_simd_2_mod
real :: b(128)
integer :: i
!$omp simd
do i = 1, 128
b(i) = i * 2.0
end do
!$omp simd
do i = 1, 128
b(i) = foo (7.0_8, 5 * i, b(i))
end do
do i = 1, 128
if (b(i).ne.(7.0 + 10.0 * i * i)) call abort
end do
end subroutine bar

203
libgomp/testsuite/libgomp.fortran/depend-1.f90 Normal file
View File

@ -0,0 +1,203 @@
! { dg-do run }
call dep ()
call dep2 ()
call dep3 ()
call firstpriv ()
call antidep ()
call antidep2 ()
call antidep3 ()
call outdep ()
call concurrent ()
call concurrent2 ()
call concurrent3 ()
contains
subroutine dep
integer :: x
x = 1
!$omp parallel
!$omp single
!$omp task shared (x) depend(out: x)
x = 2
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp end single
!$omp end parallel
end subroutine dep
subroutine dep2
integer :: x
!$omp parallel
!$omp single private (x)
x = 1
!$omp task shared (x) depend(out: x)
x = 2
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp taskwait
!$omp end single
!$omp end parallel
end subroutine dep2
subroutine dep3
integer :: x
!$omp parallel private (x)
x = 1
!$omp single
!$omp task shared (x) depend(out: x)
x = 2
!$omp endtask
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp endtask
!$omp endsingle
!$omp endparallel
end subroutine dep3
subroutine firstpriv
integer :: x
!$omp parallel private (x)
!$omp single
x = 1
!$omp task depend(out: x)
x = 2
!$omp end task
!$omp task depend(in: x)
if (x.ne.1) call abort
!$omp end task
!$omp end single
!$omp end parallel
end subroutine firstpriv
subroutine antidep
integer :: x
x = 1
!$omp parallel
!$omp single
!$omp task shared(x) depend(in: x)
if (x.ne.1) call abort
!$omp end task
!$omp task shared(x) depend(out: x)
x = 2
!$omp end task
!$omp end single
!$omp end parallel
end subroutine antidep
subroutine antidep2
integer :: x
!$omp parallel private (x)
!$omp single
x = 1
!$omp taskgroup
!$omp task shared(x) depend(in: x)
if (x.ne.1) call abort
!$omp end task
!$omp task shared(x) depend(out: x)
x = 2
!$omp end task
!$omp end taskgroup
!$omp end single
!$omp end parallel
end subroutine antidep2
subroutine antidep3
integer :: x
!$omp parallel
x = 1
!$omp single
!$omp task shared(x) depend(in: x)
if (x.ne.1) call abort
!$omp end task
!$omp task shared(x) depend(out: x)
x = 2
!$omp end task
!$omp end single
!$omp end parallel
end subroutine antidep3
subroutine outdep
integer :: x
!$omp parallel private (x)
!$omp single
x = 0
!$omp task shared(x) depend(out: x)
x = 1
!$omp end task
!$omp task shared(x) depend(out: x)
x = 2
!$omp end task
!$omp taskwait
if (x.ne.2) call abort
!$omp end single
!$omp end parallel
end subroutine outdep
subroutine concurrent
integer :: x
x = 1
!$omp parallel
!$omp single
!$omp task shared (x) depend(out: x)
x = 2
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp end single
!$omp end parallel
end subroutine concurrent
subroutine concurrent2
integer :: x
!$omp parallel private (x)
!$omp single
x = 1
!$omp task shared (x) depend(out: x)
x = 2;
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp taskwait
!$omp end single
!$omp end parallel
end subroutine concurrent2
subroutine concurrent3
integer :: x
!$omp parallel private (x)
x = 1
!$omp single
!$omp task shared (x) depend(out: x)
x = 2
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp task shared (x) depend(in: x)
if (x.ne.2) call abort
!$omp end task
!$omp end single
!$omp end parallel
end subroutine concurrent3
end

34
libgomp/testsuite/libgomp.fortran/depend-2.f90 Normal file
View File

@ -0,0 +1,34 @@
! { dg-do run }
integer :: x(3:6, 7:12), y
y = 1
!$omp parallel shared (x, y)
!$omp single
!$omp taskgroup
!$omp task depend(in: x(:, :))
if (y.ne.1) call abort
!$omp end task
!$omp task depend(out: x(:, :))
y = 2
!$omp end task
!$omp end taskgroup
!$omp taskgroup
!$omp task depend(in: x(4, 7))
if (y.ne.2) call abort
!$omp end task
!$omp task depend(out: x(4:4, 7:7))
y = 3
!$omp end task
!$omp end taskgroup
!$omp taskgroup
!$omp task depend(in: x(4:, 8:))
if (y.ne.3) call abort
!$omp end task
!$omp task depend(out: x(4:6, 8:12))
y = 4
!$omp end task
!$omp end taskgroup
!$omp end single
!$omp end parallel
if (y.ne.4) call abort
end

59
libgomp/testsuite/libgomp.fortran/omp_atomic5.f90 Normal file
View File

@ -0,0 +1,59 @@
! { dg-do run }
integer (kind = 4) :: a, a2
integer (kind = 2) :: b, b2
real :: c
double precision :: d, d2, c2
integer, dimension (10) :: e
e(:) = 5
e(7) = 9
!$omp atomic write seq_cst
a = 1
!$omp atomic seq_cst, write
b = 2
!$omp atomic write, seq_cst
c = 3
!$omp atomic seq_cst write
d = 4
!$omp atomic capture seq_cst
a2 = a
a = a + 4
!$omp end atomic
!$omp atomic capture, seq_cst
b = b - 18
b2 = b
!$omp end atomic
!$omp atomic seq_cst, capture
c2 = c
c = 2.0 * c
!$omp end atomic
!$omp atomic seq_cst capture
d = d / 2.0
d2 = d
!$omp end atomic
if (a2 .ne. 1 .or. b2 .ne. -16 .or. c2 .ne. 3 .or. d2 .ne. 2) call abort
!$omp atomic read seq_cst
a2 = a
!$omp atomic seq_cst, read
c2 = c
if (a2 .ne. 5 .or. b2 .ne. -16 .or. c2 .ne. 6 .or. d2 .ne. 2) call abort
a2 = 10
if (a2 .ne. 10) call abort
!$omp atomic capture
a2 = a
a = e(1) + e(6) + e(7) * 2
!$omp endatomic
if (a2 .ne. 5) call abort
!$omp atomic read
a2 = a
!$omp end atomic
if (a2 .ne. 28) call abort
!$omp atomic capture seq_cst
b2 = b
b = e(1) + e(7) + e(5) * 2
!$omp end atomic
if (b2 .ne. -16) call abort
!$omp atomic seq_cst, read
b2 = b
!$omp end atomic
if (b2 .ne. 24) call abort
end

23
libgomp/testsuite/libgomp.fortran/simd1.f90 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do run }
! { dg-additional-options "-msse2" { target sse2_runtime } }
! { dg-additional-options "-mavx" { target avx_runtime } }
integer :: i, j, k, l, r, a(30)
integer, target :: q(30)
integer, pointer :: p(:)
a(:) = 1
q(:) = 1
p => q
r = 0
j = 10
k = 20
!$omp simd safelen (8) reduction(+:r) linear(j, k : 2) &
!$omp& private (l) aligned(p : 4)
do i = 1, 30
l = j + k + a(i) + p(i)
r = r + l
j = j + 2
k = k + 2
end do
if (r.ne.2700.or.j.ne.70.or.k.ne.80) call abort
end

101
libgomp/testsuite/libgomp.fortran/simd2.f90 Normal file
View File

@ -0,0 +1,101 @@
! { dg-do run }
! { dg-additional-options "-msse2" { target sse2_runtime } }
! { dg-additional-options "-mavx" { target avx_runtime } }
integer :: a(1024), b(1024), k, m, i, s, t
k = 4
m = 2
t = 1
do i = 1, 1024
a(i) = i - 513
b(i) = modulo (i - 52, 39)
if (i.lt.52.and.b(i).ne.0) b(i) = b(i) - 39
end do
s = foo (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
a(i) = i - 513
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
k = 4
m = 2
t = 1
s = bar (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
a(i) = i - 513
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
k = 4
m = 2
t = 1
s = baz (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
contains
function foo (p)
integer :: p(1024), u, v, i, s, foo
s = 0
!$omp simd linear(k : m + 1) reduction(+: s) lastprivate(u, v)
do i = 1, 1024
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
!$omp end simd
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
foo = s
end function foo
function bar (p)
integer :: p(1024), u, v, i, s, bar
s = 0
!$omp simd linear(k : m + 1) reduction(+: s) lastprivate(u, v)
do i = 1, 1024, t
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
!$omp end simd
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
bar = s
end function bar
function baz (p)
integer :: p(1024), u, v, i, s, baz
s = 0
!$omp simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) &
!$omp & linear(i : t)
do i = 1, 1024, t
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
baz = s
end function baz
end

109
libgomp/testsuite/libgomp.fortran/simd3.f90 Normal file
View File

@ -0,0 +1,109 @@
! { dg-do run }
! { dg-additional-options "-msse2" { target sse2_runtime } }
! { dg-additional-options "-mavx" { target avx_runtime } }
integer :: a(1024), b(1024), k, m, i, s, t
k = 4
m = 2
t = 1
do i = 1, 1024
a(i) = i - 513
b(i) = modulo (i - 52, 39)
if (i.lt.52.and.b(i).ne.0) b(i) = b(i) - 39
end do
s = foo (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
a(i) = i - 513
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
k = 4
m = 2
t = 1
s = bar (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
a(i) = i - 513
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
k = 4
m = 2
t = 1
s = baz (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
contains
function foo (p)
integer :: p(1024), u, v, i, s, foo
s = 0
!$omp parallel
!$omp do simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) &
!$omp & schedule (static, 32)
do i = 1, 1024
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
!$omp end do simd
!$omp end parallel
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
foo = s
end function foo
function bar (p)
integer :: p(1024), u, v, i, s, bar
s = 0
!$omp parallel
!$omp do simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) &
!$omp & schedule (dynamic, 32)
do i = 1, 1024, t
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
!$omp end do simd
!$omp endparallel
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
bar = s
end function bar
function baz (p)
integer :: p(1024), u, v, i, s, baz
s = 0
!$omp parallel
!$omp do simd linear(k : m + 1) reduction(+: s) lastprivate(u, v) &
!$omp & linear(i : t) schedule (static, 8)
do i = 1, 1024, t
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
!$omp end parallel
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
baz = s
end function baz
end

103
libgomp/testsuite/libgomp.fortran/simd4.f90 Normal file
View File

@ -0,0 +1,103 @@
! { dg-do run }
! { dg-additional-options "-msse2" { target sse2_runtime } }
! { dg-additional-options "-mavx" { target avx_runtime } }
integer :: a(1024), b(1024), k, m, i, s, t
k = 4
m = 2
t = 1
do i = 1, 1024
a(i) = i - 513
b(i) = modulo (i - 52, 39)
if (i.lt.52.and.b(i).ne.0) b(i) = b(i) - 39
end do
s = foo (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
a(i) = i - 513
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
k = 4
m = 2
t = 1
s = bar (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
a(i) = i - 513
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
k = 4
m = 2
t = 1
s = baz (b)
do i = 1, 1024
if (a(i).ne.((i - 513) * b(i))) call abort
if (i.lt.52.and.modulo (i - 52, 39).ne.0) then
if (b(i).ne.(modulo (i - 52, 39) - 39)) call abort
else
if (b(i).ne.(modulo (i - 52, 39))) call abort
end if
end do
if (k.ne.(4 + 3 * 1024).or.s.ne.1596127) call abort
contains
function foo (p)
integer :: p(1024), u, v, i, s, foo
s = 0
!$omp parallel do simd linear(k : m + 1) reduction(+: s) &
!$omp & lastprivate(u, v) schedule (static, 32)
do i = 1, 1024
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
!$omp end parallel do simd
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
foo = s
end function foo
function bar (p)
integer :: p(1024), u, v, i, s, bar
s = 0
!$omp parallel do simd linear(k : m + 1) reduction(+: s) &
!$omp & lastprivate(u, v) schedule (dynamic, 32)
do i = 1, 1024, t
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
!$omp endparalleldosimd
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
bar = s
end function bar
function baz (p)
integer :: p(1024), u, v, i, s, baz
s = 0
!$omp parallel do simd linear(k : m + 1) reduction(+: s) &
!$omp & lastprivate(u, v) linear(i : t) schedule (static, 8)
do i = 1, 1024, t
a(i) = a(i) * p(i)
u = p(i) + k
k = k + m + 1
v = p(i) + k
s = s + p(i) + k
end do
if (i.ne.1025) call abort
if (u.ne.(36 + 4 + 3 * 1023).or.v.ne.(36 + 4 + 3 * 1024)) call abort
baz = s
end function baz
end

80
libgomp/testsuite/libgomp.fortran/taskgroup1.f90 Normal file
View File

@ -0,0 +1,80 @@
integer :: v(16), i
do i = 1, 16
v(i) = i
end do
!$omp parallel num_threads (4)
!$omp single
!$omp taskgroup
do i = 1, 16, 2
!$omp task
!$omp task
v(i) = v(i) + 1
!$omp end task
!$omp task
v(i + 1) = v(i + 1) + 1
!$omp end task
!$omp end task
end do
!$omp end taskgroup
do i = 1, 16
if (v(i).ne.(i + 1)) call abort
end do
!$omp taskgroup
do i = 1, 16, 2
!$omp task
!$omp task
v(i) = v(i) + 1
!$omp endtask
!$omp task
v(i + 1) = v(i + 1) + 1
!$omp endtask
!$omp taskwait
!$omp endtask
end do
!$omp endtaskgroup
do i = 1, 16
if (v(i).ne.(i + 2)) call abort
end do
!$omp taskgroup
do i = 1, 16, 2
!$omp task
!$omp task
v(i) = v(i) + 1
!$omp end task
v(i + 1) = v(i + 1) + 1
!$omp end task
end do
!$omp taskwait
do i = 1, 16, 2
!$omp task
v(i + 1) = v(i + 1) + 1
!$omp end task
end do
!$omp end taskgroup
do i = 1, 16, 2
if (v(i).ne.(i + 3)) call abort
if (v(i + 1).ne.(i + 5)) call abort
end do
!$omp taskgroup
do i = 1, 16, 2
!$omp taskgroup
!$omp task
v(i) = v(i) + 1
!$omp end task
!$omp task
v(i + 1) = v(i + 1) + 1
!$omp end task
!$omp end taskgroup
if (v(i).ne.(i + 4).or.v(i + 1).ne.(i + 6)) call abort
!$omp task
v(i) = v(i) + 1
!$omp end task
end do
!$omp end taskgroup
do i = 1, 16
if (v(i).ne.(i + 5)) call abort
end do
!$omp end single
!$omp end parallel
end