* 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
+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
+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):
}
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
{
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;
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:
if (c->ext.omp_namelist)
{
fputs (" (", dumpfile);
- show_namelist (c->ext.omp_namelist);
+ show_omp_namelist (c->ext.omp_namelist);
fputc (')', dumpfile);
}
return;
{
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);
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)
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)
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)
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)
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:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
in_omp_workshare = false;
/* 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
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;
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;
#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,
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,
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. */
/* 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;
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;
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;
}
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 *);
/* 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 *);
&& 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
}
+/* 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
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);
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.
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 ();
}
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
+ gfc_free_expr (c->safelen_expr);
+ gfc_free_expr (c->simdlen_expr);
for (i = 0; i < OMP_LIST_NUM; i++)
- gfc_free_namelist (c->lists[i]);
+ gfc_free_omp_namelist (c->lists[i]);
free (c);
}
+/* Free an !$omp declare simd construct list. */
+
+void
+gfc_free_omp_declare_simd (gfc_omp_declare_simd *ods)
+{
+ if (ods)
+ {
+ gfc_free_omp_clauses (ods->clauses);
+ free (ods);
+ }
+}
+
+void
+gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *list)
+{
+ while (list)
+ {
+ gfc_omp_declare_simd *current = list;
+ list = list->next;
+ gfc_free_omp_declare_simd (current);
+ }
+}
+
+
/* Match a variable/common block list and construct a namelist from it. */
static match
-gfc_match_omp_variable_list (const char *str, gfc_namelist **list,
- bool allow_common)
+gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
+ bool allow_common, bool *end_colon = NULL,
+ gfc_omp_namelist ***headp = NULL,
+ bool allow_sections = false)
{
- gfc_namelist *head, *tail, *p;
- locus old_loc;
+ gfc_omp_namelist *head, *tail, *p;
+ locus old_loc, cur_loc;
char n[GFC_MAX_SYMBOL_LEN+1];
gfc_symbol *sym;
match m;
for (;;)
{
+ cur_loc = gfc_current_locus;
m = gfc_match_symbol (&sym, 1);
switch (m)
{
case MATCH_YES:
+ gfc_expr *expr;
+ expr = NULL;
+ if (allow_sections && gfc_peek_ascii_char () == '(')
+ {
+ gfc_current_locus = cur_loc;
+ m = gfc_match_variable (&expr, 0);
+ switch (m)
+ {
+ case MATCH_ERROR:
+ goto cleanup;
+ case MATCH_NO:
+ goto syntax;
+ default:
+ break;
+ }
+ }
gfc_set_sym_referenced (sym);
- p = gfc_get_namelist ();
+ p = gfc_get_omp_namelist ();
if (head == NULL)
head = tail = p;
else
tail = tail->next;
}
tail->sym = sym;
+ tail->expr = expr;
goto next_item;
case MATCH_NO:
break;
for (sym = st->n.common->head; sym; sym = sym->common_next)
{
gfc_set_sym_referenced (sym);
- p = gfc_get_namelist ();
+ p = gfc_get_omp_namelist ();
if (head == NULL)
head = tail = p;
else
}
next_item:
+ if (end_colon && gfc_match_char (':') == MATCH_YES)
+ {
+ *end_colon = true;
+ break;
+ }
if (gfc_match_char (')') == MATCH_YES)
break;
if (gfc_match_char (',') != MATCH_YES)
list = &(*list)->next;
*list = head;
+ if (headp)
+ *headp = list;
return MATCH_YES;
syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_namelist (head);
+ gfc_free_omp_namelist (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
#define OMP_CLAUSE_UNTIED (1 << 13)
#define OMP_CLAUSE_FINAL (1 << 14)
#define OMP_CLAUSE_MERGEABLE (1 << 15)
+#define OMP_CLAUSE_ALIGNED (1 << 16)
+#define OMP_CLAUSE_DEPEND (1 << 17)
+#define OMP_CLAUSE_INBRANCH (1 << 18)
+#define OMP_CLAUSE_LINEAR (1 << 19)
+#define OMP_CLAUSE_NOTINBRANCH (1 << 20)
+#define OMP_CLAUSE_PROC_BIND (1 << 21)
+#define OMP_CLAUSE_SAFELEN (1 << 22)
+#define OMP_CLAUSE_SIMDLEN (1 << 23)
+#define OMP_CLAUSE_UNIFORM (1 << 24)
/* Match OpenMP directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
-gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask, bool first = true,
+ bool needs_space = true)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
- bool needs_space = true, first = true;
*cp = NULL;
while (1)
continue;
}
}
+ if ((mask & OMP_CLAUSE_INBRANCH) && !c->inbranch
+ && gfc_match ("inbranch") == MATCH_YES)
+ {
+ c->inbranch = needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_NOTINBRANCH) && !c->notinbranch
+ && gfc_match ("notinbranch") == MATCH_YES)
+ {
+ c->notinbranch = needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_PROC_BIND)
+ && c->proc_bind == OMP_PROC_BIND_UNKNOWN)
+ {
+ if (gfc_match ("proc_bind ( master )") == MATCH_YES)
+ c->proc_bind = OMP_PROC_BIND_MASTER;
+ else if (gfc_match ("proc_bind ( spread )") == MATCH_YES)
+ c->proc_bind = OMP_PROC_BIND_SPREAD;
+ else if (gfc_match ("proc_bind ( close )") == MATCH_YES)
+ c->proc_bind = OMP_PROC_BIND_CLOSE;
+ if (c->proc_bind != OMP_PROC_BIND_UNKNOWN)
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_SAFELEN) && c->safelen_expr == NULL
+ && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_SIMDLEN) && c->simdlen_expr == NULL
+ && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_UNIFORM)
+ && gfc_match_omp_variable_list ("uniform (",
+ &c->lists[OMP_LIST_UNIFORM], false)
+ == MATCH_YES)
+ continue;
+ bool end_colon = false;
+ gfc_omp_namelist **head = NULL;
+ old_loc = gfc_current_locus;
+ if ((mask & OMP_CLAUSE_ALIGNED)
+ && gfc_match_omp_variable_list ("aligned (",
+ &c->lists[OMP_LIST_ALIGNED], false,
+ &end_colon, &head)
+ == MATCH_YES)
+ {
+ gfc_expr *alignment = NULL;
+ gfc_omp_namelist *n;
+
+ if (end_colon
+ && gfc_match (" %e )", &alignment) != MATCH_YES)
+ {
+ gfc_free_omp_namelist (*head);
+ gfc_current_locus = old_loc;
+ *head = NULL;
+ break;
+ }
+ for (n = *head; n; n = n->next)
+ if (n->next && alignment)
+ n->expr = gfc_copy_expr (alignment);
+ else
+ n->expr = alignment;
+ continue;
+ }
+ end_colon = false;
+ head = NULL;
+ old_loc = gfc_current_locus;
+ if ((mask & OMP_CLAUSE_LINEAR)
+ && gfc_match_omp_variable_list ("linear (",
+ &c->lists[OMP_LIST_LINEAR], false,
+ &end_colon, &head)
+ == MATCH_YES)
+ {
+ gfc_expr *step = NULL;
+
+ if (end_colon
+ && gfc_match (" %e )", &step) != MATCH_YES)
+ {
+ gfc_free_omp_namelist (*head);
+ gfc_current_locus = old_loc;
+ *head = NULL;
+ break;
+ }
+ else if (!end_colon)
+ {
+ step = gfc_get_constant_expr (BT_INTEGER,
+ gfc_default_integer_kind,
+ &old_loc);
+ mpz_set_si (step->value.integer, 1);
+ }
+ (*head)->expr = step;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_DEPEND)
+ && gfc_match_omp_variable_list ("depend ( in : ",
+ &c->lists[OMP_LIST_DEPEND_IN], false,
+ NULL, NULL, true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEPEND)
+ && gfc_match_omp_variable_list ("depend ( out : ",
+ &c->lists[OMP_LIST_DEPEND_OUT], false,
+ NULL, NULL, true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEPEND)
+ && gfc_match_omp_variable_list ("depend ( inout : ",
+ &c->lists[OMP_LIST_DEPEND_OUT], false,
+ NULL, NULL, true)
+ == MATCH_YES)
+ continue;
break;
}
#define OMP_PARALLEL_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
| OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
- | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
+ | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PROC_BIND)
+#define OMP_DECLARE_SIMD_CLAUSES \
+ (OMP_CLAUSE_SIMDLEN | OMP_CLAUSE_LINEAR | OMP_CLAUSE_UNIFORM \
+ | OMP_CLAUSE_ALIGNED)
#define OMP_DO_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
#define OMP_SECTIONS_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_SIMD_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN | OMP_CLAUSE_LINEAR \
+ | OMP_CLAUSE_ALIGNED)
#define OMP_TASK_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
| OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
- | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
+ | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_DEPEND)
match
gfc_match_omp_parallel (void)
}
+match
+gfc_match_omp_do_simd (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, ((OMP_DO_CLAUSES | OMP_SIMD_CLAUSES)
+ & ~OMP_CLAUSE_ORDERED))
+ != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_DO_SIMD;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
match
gfc_match_omp_flush (void)
{
- gfc_namelist *list = NULL;
+ gfc_omp_namelist *list = NULL;
gfc_match_omp_variable_list (" (", &list, true);
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
- gfc_free_namelist (list);
+ gfc_free_omp_namelist (list);
return MATCH_ERROR;
}
new_st.op = EXEC_OMP_FLUSH;
}
+match
+gfc_match_omp_simd (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_SIMD_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_SIMD;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_declare_simd (void)
+{
+ locus where = gfc_current_locus;
+ gfc_symbol *proc_name;
+ gfc_omp_clauses *c;
+ gfc_omp_declare_simd *ods;
+
+ if (gfc_match (" ( %s ) ", &proc_name) != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true,
+ false) != MATCH_YES)
+ return MATCH_ERROR;
+
+ ods = gfc_get_omp_declare_simd ();
+ ods->where = where;
+ ods->proc_name = proc_name;
+ ods->clauses = c;
+ ods->next = gfc_current_ns->omp_declare_simd;
+ gfc_current_ns->omp_declare_simd = ods;
+ return MATCH_YES;
+}
+
+
match
gfc_match_omp_threadprivate (void)
{
}
+match
+gfc_match_omp_parallel_do_simd (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES
+ | OMP_SIMD_CLAUSES) & ~OMP_CLAUSE_ORDERED)
+ != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_PARALLEL_DO_SIMD;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
match
gfc_match_omp_parallel_sections (void)
{
gfc_match_omp_atomic (void)
{
gfc_omp_atomic_op op = GFC_OMP_ATOMIC_UPDATE;
- if (gfc_match ("% update") == MATCH_YES)
- op = GFC_OMP_ATOMIC_UPDATE;
- else if (gfc_match ("% read") == MATCH_YES)
- op = GFC_OMP_ATOMIC_READ;
- else if (gfc_match ("% write") == MATCH_YES)
- op = GFC_OMP_ATOMIC_WRITE;
- else if (gfc_match ("% capture") == MATCH_YES)
- op = GFC_OMP_ATOMIC_CAPTURE;
+ int seq_cst = 0;
+ if (gfc_match ("% seq_cst") == MATCH_YES)
+ seq_cst = 1;
+ locus old_loc = gfc_current_locus;
+ if (seq_cst && gfc_match_char (',') == MATCH_YES)
+ seq_cst = 2;
+ if (seq_cst == 2
+ || gfc_match_space () == MATCH_YES)
+ {
+ gfc_gobble_whitespace ();
+ if (gfc_match ("update") == MATCH_YES)
+ op = GFC_OMP_ATOMIC_UPDATE;
+ else if (gfc_match ("read") == MATCH_YES)
+ op = GFC_OMP_ATOMIC_READ;
+ else if (gfc_match ("write") == MATCH_YES)
+ op = GFC_OMP_ATOMIC_WRITE;
+ else if (gfc_match ("capture") == MATCH_YES)
+ op = GFC_OMP_ATOMIC_CAPTURE;
+ else
+ {
+ if (seq_cst == 2)
+ gfc_current_locus = old_loc;
+ goto finish;
+ }
+ if (!seq_cst
+ && (gfc_match (", seq_cst") == MATCH_YES
+ || gfc_match ("% seq_cst") == MATCH_YES))
+ seq_cst = 1;
+ }
+ finish:
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C");
return MATCH_ERROR;
}
new_st.op = EXEC_OMP_ATOMIC;
+ if (seq_cst)
+ op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST);
new_st.ext.omp_atomic = op;
return MATCH_YES;
}
}
+match
+gfc_match_omp_taskgroup (void)
+{
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after $OMP TASKGROUP statement at %C");
+ return MATCH_ERROR;
+ }
+ new_st.op = EXEC_OMP_TASKGROUP;
+ return MATCH_YES;
+}
+
+
+static enum gfc_omp_cancel_kind
+gfc_match_omp_cancel_kind (void)
+{
+ if (gfc_match_space () != MATCH_YES)
+ return OMP_CANCEL_UNKNOWN;
+ if (gfc_match ("parallel") == MATCH_YES)
+ return OMP_CANCEL_PARALLEL;
+ if (gfc_match ("sections") == MATCH_YES)
+ return OMP_CANCEL_SECTIONS;
+ if (gfc_match ("do") == MATCH_YES)
+ return OMP_CANCEL_DO;
+ if (gfc_match ("taskgroup") == MATCH_YES)
+ return OMP_CANCEL_TASKGROUP;
+ return OMP_CANCEL_UNKNOWN;
+}
+
+
+match
+gfc_match_omp_cancel (void)
+{
+ gfc_omp_clauses *c;
+ enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind ();
+ if (kind == OMP_CANCEL_UNKNOWN)
+ return MATCH_ERROR;
+ if (gfc_match_omp_clauses (&c, OMP_CLAUSE_IF, false) != MATCH_YES)
+ return MATCH_ERROR;
+ c->cancel = kind;
+ new_st.op = EXEC_OMP_CANCEL;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_cancellation_point (void)
+{
+ gfc_omp_clauses *c;
+ enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind ();
+ if (kind == OMP_CANCEL_UNKNOWN)
+ return MATCH_ERROR;
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement "
+ "at %C");
+ return MATCH_ERROR;
+ }
+ c = gfc_get_omp_clauses ();
+ c->cancel = kind;
+ new_st.op = EXEC_OMP_CANCELLATION_POINT;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
match
gfc_match_omp_end_nowait (void)
{
/* OpenMP directive resolving routines. */
static void
-resolve_omp_clauses (gfc_code *code)
+resolve_omp_clauses (gfc_code *code, locus *where,
+ gfc_omp_clauses *omp_clauses, gfc_namespace *ns)
{
- gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
- gfc_namelist *n;
+ gfc_omp_namelist *n;
int list;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "REDUCTION" };
+ "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "DEPEND",
+ "REDUCTION" };
if (omp_clauses == NULL)
return;
for (n = omp_clauses->lists[list]; n; n = n->next)
{
n->sym->mark = 0;
- if (n->sym->attr.flavor == FL_VARIABLE || n->sym->attr.proc_pointer)
- continue;
+ if (n->sym->attr.flavor == FL_VARIABLE
+ || n->sym->attr.proc_pointer
+ || (!code && (!n->sym->attr.dummy || n->sym->ns != ns)))
+ {
+ if (!code && (!n->sym->attr.dummy || n->sym->ns != ns))
+ gfc_error ("Variable '%s' is not a dummy argument at %L",
+ n->sym->name, where);
+ continue;
+ }
if (n->sym->attr.flavor == FL_PROCEDURE
&& n->sym->result == n->sym
&& n->sym->attr.function)
}
}
gfc_error ("Object '%s' is not a variable at %L", n->sym->name,
- &code->loc);
+ where);
}
for (list = 0; list < OMP_LIST_NUM; list++)
- if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE)
+ if (list != OMP_LIST_FIRSTPRIVATE
+ && list != OMP_LIST_LASTPRIVATE
+ && list != OMP_LIST_ALIGNED
+ && list != OMP_LIST_DEPEND_IN
+ && list != OMP_LIST_DEPEND_OUT)
for (n = omp_clauses->lists[list]; n; n = n->next)
{
if (n->sym->mark)
gfc_error ("Symbol '%s' present on multiple clauses at %L",
- n->sym->name, &code->loc);
+ n->sym->name, where);
else
n->sym->mark = 1;
}
if (n->sym->mark)
{
gfc_error ("Symbol '%s' present on multiple clauses at %L",
- n->sym->name, &code->loc);
+ n->sym->name, where);
n->sym->mark = 0;
}
{
if (n->sym->mark)
gfc_error ("Symbol '%s' present on multiple clauses at %L",
- n->sym->name, &code->loc);
+ n->sym->name, where);
else
n->sym->mark = 1;
}
{
if (n->sym->mark)
gfc_error ("Symbol '%s' present on multiple clauses at %L",
- n->sym->name, &code->loc);
+ n->sym->name, where);
else
n->sym->mark = 1;
}
+
+ for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
+ n->sym->mark = 0;
+
+ for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ n->sym->name, where);
+ else
+ n->sym->mark = 1;
+ }
+
for (list = 0; list < OMP_LIST_NUM; list++)
if ((n = omp_clauses->lists[list]) != NULL)
{
{
if (!n->sym->attr.threadprivate)
gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
- " at %L", n->sym->name, &code->loc);
+ " at %L", n->sym->name, where);
if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components",
- n->sym->name, &code->loc);
+ n->sym->name, where);
}
break;
case OMP_LIST_COPYPRIVATE:
{
if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
- "at %L", n->sym->name, &code->loc);
+ "at %L", n->sym->name, where);
if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components",
- n->sym->name, &code->loc);
+ n->sym->name, where);
}
break;
case OMP_LIST_SHARED:
{
if (n->sym->attr.threadprivate)
gfc_error ("THREADPRIVATE object '%s' in SHARED clause at "
- "%L", n->sym->name, &code->loc);
+ "%L", n->sym->name, where);
if (n->sym->attr.cray_pointee)
gfc_error ("Cray pointee '%s' in SHARED clause at %L",
- n->sym->name, &code->loc);
+ n->sym->name, where);
+ }
+ break;
+ case OMP_LIST_ALIGNED:
+ for (; n != NULL; n = n->next)
+ {
+ if (!n->sym->attr.pointer
+ && !n->sym->attr.allocatable
+ && !n->sym->attr.cray_pointer
+ && (n->sym->ts.type != BT_DERIVED
+ || (n->sym->ts.u.derived->from_intmod
+ != INTMOD_ISO_C_BINDING)
+ || (n->sym->ts.u.derived->intmod_sym_id
+ != ISOCBINDING_PTR)))
+ gfc_error ("'%s' in ALIGNED clause must be POINTER, "
+ "ALLOCATABLE, Cray pointer or C_PTR at %L",
+ n->sym->name, where);
+ else if (n->expr)
+ {
+ gfc_expr *expr = n->expr;
+ int alignment = 0;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER
+ || expr->rank != 0
+ || gfc_extract_int (expr, &alignment)
+ || alignment <= 0)
+ gfc_error ("'%s' in ALIGNED clause at %L requires a scalar "
+ "positive constant integer alignment "
+ "expression", n->sym->name, where);
+ }
}
break;
+ case OMP_LIST_DEPEND_IN:
+ case OMP_LIST_DEPEND_OUT:
+ for (; n != NULL; n = n->next)
+ if (n->expr)
+ {
+ if (!gfc_resolve_expr (n->expr)
+ || n->expr->expr_type != EXPR_VARIABLE
+ || n->expr->ref == NULL
+ || n->expr->ref->next
+ || n->expr->ref->type != REF_ARRAY)
+ gfc_error ("'%s' in DEPEND clause at %L is not a proper "
+ "array section", n->sym->name, where);
+ else if (n->expr->ref->u.ar.codimen)
+ gfc_error ("Coarrays not supported in DEPEND clause at %L",
+ where);
+ else
+ {
+ int i;
+ gfc_array_ref *ar = &n->expr->ref->u.ar;
+ for (i = 0; i < ar->dimen; i++)
+ if (ar->stride[i])
+ {
+ gfc_error ("Stride should not be specified for "
+ "array section in DEPEND clause at %L",
+ where);
+ break;
+ }
+ else if (ar->dimen_type[i] != DIMEN_ELEMENT
+ && ar->dimen_type[i] != DIMEN_RANGE)
+ {
+ gfc_error ("'%s' in DEPEND clause at %L is not a "
+ "proper array section",
+ n->sym->name, where);
+ break;
+ }
+ else if (ar->start[i]
+ && ar->start[i]->expr_type == EXPR_CONSTANT
+ && ar->end[i]
+ && ar->end[i]->expr_type == EXPR_CONSTANT
+ && mpz_cmp (ar->start[i]->value.integer,
+ ar->end[i]->value.integer) > 0)
+ {
+ gfc_error ("'%s' in DEPEND clause at %L is a zero "
+ "size array section", n->sym->name,
+ where);
+ break;
+ }
+ }
+ }
+ break;
default:
for (; n != NULL; n = n->next)
{
if (n->sym->attr.threadprivate)
gfc_error ("THREADPRIVATE object '%s' in %s clause at %L",
- n->sym->name, name, &code->loc);
+ n->sym->name, name, where);
if (n->sym->attr.cray_pointee)
gfc_error ("Cray pointee '%s' in %s clause at %L",
- n->sym->name, name, &code->loc);
+ n->sym->name, name, where);
if (list != OMP_LIST_PRIVATE)
{
if (n->sym->attr.pointer
&& list >= OMP_LIST_REDUCTION_FIRST
&& list <= OMP_LIST_REDUCTION_LAST)
gfc_error ("POINTER object '%s' in %s clause at %L",
- n->sym->name, name, &code->loc);
+ n->sym->name, name, where);
/* Variables in REDUCTION-clauses must be of intrinsic type (flagged below). */
if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST)
&& n->sym->ts.type == BT_DERIVED
&& n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L",
- name, n->sym->name, &code->loc);
+ name, n->sym->name, where);
if (n->sym->attr.cray_pointer
&& list >= OMP_LIST_REDUCTION_FIRST
&& list <= OMP_LIST_REDUCTION_LAST)
gfc_error ("Cray pointer '%s' in %s clause at %L",
- n->sym->name, name, &code->loc);
+ n->sym->name, name, where);
}
if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array '%s' in %s clause at %L",
- n->sym->name, name, &code->loc);
+ n->sym->name, name, where);
if (n->sym->attr.in_namelist
&& (list < OMP_LIST_REDUCTION_FIRST
|| list > OMP_LIST_REDUCTION_LAST))
gfc_error ("Variable '%s' in %s clause is used in "
"NAMELIST statement at %L",
- n->sym->name, name, &code->loc);
+ n->sym->name, name, where);
switch (list)
{
case OMP_LIST_PLUS:
gfc_error ("%c REDUCTION variable '%s' at %L must be of numeric type, got %s",
list == OMP_LIST_PLUS ? '+'
: list == OMP_LIST_MULT ? '*' : '-',
- n->sym->name, &code->loc,
+ n->sym->name, where,
gfc_typename (&n->sym->ts));
break;
case OMP_LIST_AND:
list == OMP_LIST_AND ? ".AND."
: list == OMP_LIST_OR ? ".OR."
: list == OMP_LIST_EQV ? ".EQV." : ".NEQV.",
- n->sym->name, &code->loc);
+ n->sym->name, where);
break;
case OMP_LIST_MAX:
case OMP_LIST_MIN:
gfc_error ("%s REDUCTION variable '%s' must be "
"INTEGER or REAL at %L",
list == OMP_LIST_MAX ? "MAX" : "MIN",
- n->sym->name, &code->loc);
+ n->sym->name, where);
break;
case OMP_LIST_IAND:
case OMP_LIST_IOR:
"at %L",
list == OMP_LIST_IAND ? "IAND"
: list == OMP_LIST_MULT ? "IOR" : "IEOR",
- n->sym->name, &code->loc);
+ n->sym->name, where);
+ break;
+ case OMP_LIST_LINEAR:
+ if (n->sym->ts.type != BT_INTEGER)
+ gfc_error ("LINEAR variable '%s' must be INTEGER "
+ "at %L", n->sym->name, where);
+ else if (!code && !n->sym->attr.value)
+ gfc_error ("LINEAR dummy argument '%s' must have VALUE "
+ "attribute at %L", n->sym->name, where);
+ else if (n->expr)
+ {
+ gfc_expr *expr = n->expr;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER
+ || expr->rank != 0)
+ gfc_error ("'%s' in LINEAR clause at %L requires "
+ "a scalar integer linear-step expression",
+ n->sym->name, where);
+ else if (!code && expr->expr_type != EXPR_CONSTANT)
+ gfc_error ("'%s' in LINEAR clause at %L requires "
+ "a constant integer linear-step expression",
+ n->sym->name, where);
+ }
break;
/* Workaround for PR middle-end/26316, nothing really needs
to be done here for OMP_LIST_PRIVATE. */
case OMP_LIST_PRIVATE:
- gcc_assert (code->op != EXEC_NOP);
+ gcc_assert (code && code->op != EXEC_NOP);
default:
break;
}
break;
}
}
+ if (omp_clauses->safelen_expr)
+ {
+ gfc_expr *expr = omp_clauses->safelen_expr;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("SAFELEN clause at %L requires a scalar "
+ "INTEGER expression", &expr->where);
+ }
+ if (omp_clauses->simdlen_expr)
+ {
+ gfc_expr *expr = omp_clauses->simdlen_expr;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("SIMDLEN clause at %L requires a scalar "
+ "INTEGER expression", &expr->where);
+ }
}
gfc_code *atomic_code = code;
gfc_symbol *var;
gfc_expr *expr2, *expr2_tmp;
+ gfc_omp_atomic_op aop
+ = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK);
code = code->block->next;
gcc_assert (code->op == EXEC_ASSIGN);
- gcc_assert ((atomic_code->ext.omp_atomic != GFC_OMP_ATOMIC_CAPTURE
- && code->next == NULL)
- || (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE
+ gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) && code->next == NULL)
+ || ((aop == GFC_OMP_ATOMIC_CAPTURE)
&& code->next != NULL
&& code->next->op == EXEC_ASSIGN
&& code->next->next == NULL));
expr2 = is_conversion (code->expr2, false);
if (expr2 == NULL)
{
- if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_READ
- || atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
+ if (aop == GFC_OMP_ATOMIC_READ || aop == GFC_OMP_ATOMIC_WRITE)
expr2 = is_conversion (code->expr2, true);
if (expr2 == NULL)
expr2 = code->expr2;
}
- switch (atomic_code->ext.omp_atomic)
+ switch (aop)
{
case GFC_OMP_ATOMIC_READ:
if (expr2->expr_type != EXPR_VARIABLE
break;
}
- if (expr2->expr_type == EXPR_OP)
+ if (var->attr.allocatable)
+ {
+ gfc_error ("!$OMP ATOMIC with ALLOCATABLE variable at %L",
+ &code->loc);
+ return;
+ }
+
+ if (aop == GFC_OMP_ATOMIC_CAPTURE
+ && code->next == NULL
+ && code->expr2->rank == 0
+ && !expr_references_sym (code->expr2, var, NULL))
+ atomic_code->ext.omp_atomic
+ = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic
+ | GFC_OMP_ATOMIC_SWAP);
+ else if (expr2->expr_type == EXPR_OP)
{
gfc_expr *v = NULL, *e, *c;
gfc_intrinsic_op op = expr2->value.op.op;
&& arg->expr->symtree->n.sym == var)
var_arg = arg;
else if (expr_references_sym (arg->expr, var, NULL))
- gfc_error ("!$OMP ATOMIC intrinsic arguments except one must not "
- "reference '%s' at %L", var->name, &arg->expr->where);
+ {
+ gfc_error ("!$OMP ATOMIC intrinsic arguments except one must "
+ "not reference '%s' at %L",
+ var->name, &arg->expr->where);
+ return;
+ }
if (arg->expr->rank != 0)
- gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar "
- "at %L", &arg->expr->where);
+ {
+ gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar "
+ "at %L", &arg->expr->where);
+ return;
+ }
}
if (var_arg == NULL)
}
}
else
- gfc_error ("!$OMP ATOMIC assignment must have an operator or intrinsic "
- "on right hand side at %L", &expr2->where);
+ gfc_error ("!$OMP ATOMIC assignment must have an operator or "
+ "intrinsic on right hand side at %L", &expr2->where);
- if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE && code->next)
+ if (aop == GFC_OMP_ATOMIC_CAPTURE && code->next)
{
code = code->next;
if (code->expr1->expr_type != EXPR_VARIABLE
{
struct omp_context ctx;
gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
- gfc_namelist *n;
+ gfc_omp_namelist *n;
int list;
ctx.code = code;
for (n = omp_clauses->lists[list]; n; n = n->next)
pointer_set_insert (ctx.sharing_clauses, n->sym);
- if (code->op == EXEC_OMP_PARALLEL_DO)
+ if (code->op == EXEC_OMP_PARALLEL_DO
+ || code->op == EXEC_OMP_PARALLEL_DO_SIMD)
gfc_resolve_omp_do_blocks (code, ns);
else
gfc_resolve_blocks (code->block, ns);
if (! pointer_set_insert (omp_current_ctx->private_iterators, sym))
{
gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
- gfc_namelist *p;
+ gfc_omp_namelist *p;
- p = gfc_get_namelist ();
+ p = gfc_get_omp_namelist ();
p->sym = sym;
p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
omp_clauses->lists[OMP_LIST_PRIVATE] = p;
{
gfc_code *do_code, *c;
int list, i, collapse;
- gfc_namelist *n;
+ gfc_omp_namelist *n;
gfc_symbol *dovar;
+ const char *name;
+ bool is_simd = false;
+
+ switch (code->op)
+ {
+ case EXEC_OMP_DO: name = "!$OMP DO"; break;
+ case EXEC_OMP_DO_SIMD: name = "!$OMP DO SIMD"; is_simd = true; break;
+ case EXEC_OMP_PARALLEL_DO: name = "!$OMP PARALLEL DO"; break;
+ case EXEC_OMP_PARALLEL_DO_SIMD:
+ name = "!$OMP PARALLEL DO SIMD";
+ is_simd = true; break;
+ case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break;
+ default: gcc_unreachable ();
+ }
if (code->ext.omp_clauses)
- resolve_omp_clauses (code);
+ resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
do_code = code->block->next;
collapse = code->ext.omp_clauses->collapse;
{
if (do_code->op == EXEC_DO_WHILE)
{
- gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control "
- "at %L", &do_code->loc);
+ gfc_error ("%s cannot be a DO WHILE or DO without loop control "
+ "at %L", name, &do_code->loc);
break;
}
gcc_assert (do_code->op == EXEC_DO);
if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
- gfc_error ("!$OMP DO iteration variable must be of type integer at %L",
- &do_code->loc);
+ gfc_error ("%s iteration variable must be of type integer at %L",
+ name, &do_code->loc);
dovar = do_code->ext.iterator->var->symtree->n.sym;
if (dovar->attr.threadprivate)
- gfc_error ("!$OMP DO iteration variable must not be THREADPRIVATE "
- "at %L", &do_code->loc);
+ gfc_error ("%s iteration variable must not be THREADPRIVATE "
+ "at %L", name, &do_code->loc);
if (code->ext.omp_clauses)
for (list = 0; list < OMP_LIST_NUM; list++)
- if (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
+ if (!is_simd
+ ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
+ : code->ext.omp_clauses->collapse > 1
+ ? (list != OMP_LIST_LASTPRIVATE)
+ : (list != OMP_LIST_LINEAR))
for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
if (dovar == n->sym)
{
- gfc_error ("!$OMP DO iteration variable present on clause "
- "other than PRIVATE or LASTPRIVATE at %L",
- &do_code->loc);
+ if (!is_simd)
+ gfc_error ("%s iteration variable present on clause "
+ "other than PRIVATE or LASTPRIVATE at %L",
+ name, &do_code->loc);
+ else if (code->ext.omp_clauses->collapse > 1)
+ gfc_error ("%s iteration variable present on clause "
+ "other than LASTPRIVATE at %L",
+ name, &do_code->loc);
+ else
+ gfc_error ("%s iteration variable present on clause "
+ "other than LINEAR at %L",
+ name, &do_code->loc);
break;
}
if (i > 1)
|| gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
|| gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
{
- gfc_error ("!$OMP DO collapsed loops don't form rectangular iteration space at %L",
- &do_code->loc);
+ gfc_error ("%s collapsed loops don't form rectangular "
+ "iteration space at %L", name, &do_code->loc);
break;
}
if (j < i)
for (c = do_code->next; c; c = c->next)
if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
{
- gfc_error ("collapsed !$OMP DO loops not perfectly nested at %L",
- &c->loc);
+ gfc_error ("collapsed %s loops not perfectly nested at %L",
+ name, &c->loc);
break;
}
if (c)
do_code = do_code->block;
if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
{
- gfc_error ("not enough DO loops for collapsed !$OMP DO at %L",
- &code->loc);
+ gfc_error ("not enough DO loops for collapsed %s at %L",
+ name, &code->loc);
break;
}
do_code = do_code->next;
if (do_code == NULL
|| (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
{
- gfc_error ("not enough DO loops for collapsed !$OMP DO at %L",
- &code->loc);
+ gfc_error ("not enough DO loops for collapsed %s at %L",
+ name, &code->loc);
break;
}
}
switch (code->op)
{
case EXEC_OMP_DO:
+ case EXEC_OMP_DO_SIMD:
case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_SIMD:
resolve_omp_do (code);
break;
- case EXEC_OMP_WORKSHARE:
+ case EXEC_OMP_CANCEL:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
case EXEC_OMP_TASK:
+ case EXEC_OMP_WORKSHARE:
if (code->ext.omp_clauses)
- resolve_omp_clauses (code);
+ resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
break;
case EXEC_OMP_ATOMIC:
resolve_omp_atomic (code);
break;
}
}
+
+/* Resolve !$omp declare simd constructs in NS. */
+
+void
+gfc_resolve_omp_declare_simd (gfc_namespace *ns)
+{
+ gfc_omp_declare_simd *ods;
+
+ for (ods = ns->omp_declare_simd; ods; ods = ods->next)
+ {
+ if (ods->proc_name != ns->proc_name)
+ gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure"
+ "'%s' at %L", ns->proc_name->name, &ods->where);
+ if (ods->clauses)
+ resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns);
+ }
+}
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);
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);
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);
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;
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
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(). */
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;
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;
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;
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;
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;
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;
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;
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)
{
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;
}
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;
break;
case ST_OMP_PARALLEL_DO:
+ case ST_OMP_PARALLEL_DO_SIMD:
st = parse_omp_do (st);
continue;
case ST_OMP_MASTER:
case ST_OMP_SINGLE:
case ST_OMP_TASK:
+ case ST_OMP_TASKGROUP:
parse_omp_structured_block (st, false);
break;
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;
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:
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;
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:
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:
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:
gfc_resolve_uops (ns->uop_root);
+ gfc_resolve_omp_declare_simd (ns);
+
gfc_current_ns = old_ns;
}
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:
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:
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;
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);
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;
}
/* 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
}
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;
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
}
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);
}
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,
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;
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;
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;
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;
}
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);
&& 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);
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);
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);
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
{
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
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);
}
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)
{
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;
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;
}
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)
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;
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
}
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);
}
}
/* 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);
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_parallel_do (gfc_code *code)
+gfc_trans_omp_do_simd (gfc_code *code, gfc_omp_clauses *clausesa,
+ tree omp_clauses)
{
stmtblock_t block, *pblock = NULL;
- gfc_omp_clauses parallel_clauses, do_clauses;
- tree stmt, omp_clauses = NULL_TREE;
+ gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
+ tree stmt, body, omp_do_clauses = NULL_TREE;
gfc_start_block (&block);
- memset (&do_clauses, 0, sizeof (do_clauses));
- if (code->ext.omp_clauses != NULL)
+ if (clausesa == NULL)
{
- memcpy (¶llel_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, ¶llel_clauses,
- code->loc);
+ clausesa = clausesa_buf;
+ gfc_split_omp_clauses (code, clausesa);
}
- do_clauses.nowait = true;
- if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
+ omp_do_clauses
+ = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc);
+ pblock = █
+ 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 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);
+ if (!clausesa[GFC_OMP_SPLIT_DO].ordered
+ && clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC)
pblock = █
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
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)
{
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:
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:
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:
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;
+ }
+}
/* 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 *);
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:
(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)
= 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;
&& 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));
}
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;
+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.
--- /dev/null
+ 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
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),
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,
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 */
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:
#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
+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.
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+ 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
projects / thirdparty / gcc.git / commitdiff
