aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/openmp.c
diff options
context:
space:
mode:
authorJakub Jelinek <jakub@gcc.gnu.org>2016-11-10 12:38:05 +0100
committerJakub Jelinek <jakub@gcc.gnu.org>2016-11-10 12:38:05 +0100
commitb4c3a85be96585374bf95c981ba2f602667cf5b7 (patch)
tree3567be9879613f19b407cad1c5c4fdcbd2f5d4bb /gcc/fortran/openmp.c
parent86bc85065359e0f849a12115ee487d6a408a2fe0 (diff)
downloadgcc-b4c3a85be96585374bf95c981ba2f602667cf5b7.zip
gcc-b4c3a85be96585374bf95c981ba2f602667cf5b7.tar.gz
gcc-b4c3a85be96585374bf95c981ba2f602667cf5b7.tar.bz2
omp-low.c (lower_omp_target): Fix up argument to is_reference.
gcc/ * omp-low.c (lower_omp_target): Fix up argument to is_reference. (expand_omp_ordered_sink): Handle TREE_PURPOSE of deps being TRUNC_DIV_EXPR. * gimplify.c (gimplify_scan_omp_clauses): Likewise. Set ctx->target_map_scalars_firstprivate on OMP_TARGET even for Fortran. Remove omp_no_lastprivate callers. Propagate lastprivate on combined teams distribute parallel for simd even to distribute and teams construct. For OMP_CLAUSE_DEPEND add missing break at the end of OMP_CLAUSE_DEPEND_SINK case. (omp_notice_variable): Use lang_hooks.decls.omp_scalar_p. (omp_no_lastprivate): Removed. (gimplify_adjust_omp_clauses): Remove omp_no_lastprivate callers. (gimplify_omp_for): Likewise. (computable_teams_clause): Fail for automatic vars from current function not yet seen in bind expr. * langhooks.c (lhd_omp_scalar_p): New function. * langhooks.h (struct lang_hooks_for_decls): Add omp_scalar_p. * varpool.c (varpool_node::get_create): Set node->offloading even for DECL_EXTERNAL decls. * langhooks-def.h (lhd_omp_scalar_p): New prototype. (LANG_HOOKS_OMP_SCALAR_P): Define. (LANG_HOOKS_DECLS): Use it. gcc/fortran/ * openmp.c (gfc_free_omp_clauses): Free critical_name, grainsize, hint, num_tasks, priority and if_exprs. (gfc_match_omp_to_link, gfc_match_omp_depend_sink): New functions. (enum omp_mask1, enum omp_mask2): New enums. Change all OMP_CLAUSE_* defines into enum values, and change their values from ((uint64_t) 1 << bit) to just bit. (omp_mask, omp_inv_mask): New classes. Add ctors and operators. (gfc_match_omp_clauses): Change mask argument from uint64_t to const omp_mask. Assert OMP_MASK1_LAST and OMP_MASK2_LAST are at most 64. Move delete clause handling to where it alphabetically belongs. Parse defaultmap, grainsize, hint, is_device_ptr, nogroup, nowait, num_tasks, priority, simd, threads and use_device_ptr clauses. Parse if clause modifier. Parse map clause always modifier, and release and delete kinds. Parse ordered clause with argument. Parse schedule clause modifiers. Differentiate device clause parsing based on openacc flag. Guard link clause parsing with openacc flag. Add support for parsing linear clause modifiers. Parse depend(source) and depend(sink: ...). Use gfc_match_omp_to_link for to and link clauses in declare target construct. (match_acc): Change mask type from uint64_t to const omp_mask. (OMP_SINGLE_CLAUSES, OMP_ORDERED_CLAUSES, OMP_DECLARE_TARGET_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_ENTER_DATA_CLAUSES, OMP_TARGET_EXIT_DATA_CLAUSES): Define. (OACC_PARALLEL_CLAUSES, OACC_KERNELS_CLAUSES, OACC_DATA_CLAUSES, OACC_LOOP_CLAUSES, OACC_HOST_DATA_CLAUSES, OACC_DECLARE_CLAUSES, OACC_ENTER_DATA_CLAUSES, OACC_EXIT_DATA_CLAUSES, OACC_WAIT_CLAUSES, OACC_ROUTINE_CLAUSES, OMP_PARALLEL_CLAUSES, OMP_DECLARE_SIMD_CLAUSES, OMP_SECTIONS_CLAUSES, OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES): Replace first or only OMP_CLAUSE_* value in bitset with omp_mask (OMP_CLAUSE_*). (OMP_DO_CLAUSES): Likewise. Add OMP_CLAUSE_LINEAR. (OMP_SIMD_CLAUSES): Replace first or only OMP_CLAUSE_* value in bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_SIMDLEN. (OACC_UPDATE_CLAUSES): Replace first or only OMP_CLAUSE_* value in bitset with omp_mask (OMP_CLAUSE_*). Replace OMP_CLAUSE_OACC_DEVICE with OMP_CLAUSE_DEVICE. (OMP_TASK_CLAUSES): Replace first or only OMP_CLAUSE_* value in bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_PRIORITY. (OMP_TARGET_CLAUSES): Replace first or only OMP_CLAUSE_* value in bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_DEPEND, OMP_CLAUSE_NOWAIT, OMP_CLAUSE_PRIVATE, OMP_CLAUSE_FIRSTPRIVATE, OMP_CLAUSE_DEFAULTMAP and OMP_CLAUSE_IS_DEVICE_PTR. (OMP_TARGET_DATA_CLAUSES): Replace first or only OMP_CLAUSE_* value in bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_USE_DEVICE_PTR. (OMP_TARGET_UPDATE_CLAUSES): Replace first or only OMP_CLAUSE_* value in bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_DEPEND and OMP_CLAUSE_NOWAIT. (match_omp): Change mask argument from unsigned int to const omp_mask. (gfc_match_omp_critical): Parse optional clauses and use omp_clauses union member instead of omp_name. (gfc_match_omp_end_critical): New function. (gfc_match_omp_distribute_parallel_do): Remove ordered and linear clauses from the mask. (gfc_match_omp_distribute_parallel_do_simd): Use & ~(omp_mask (OMP_CLAUSE_*)) instead of & ~OMP_CLAUSE_*. (gfc_match_omp_target_teams_distribute_parallel_do_simd): Likewise. (gfc_match_omp_teams_distribute_parallel_do_simd): Likewise. (gfc_match_omp_do_simd): Likewise. Don't remove ordered clause from the mask. (gfc_match_omp_parallel_do_simd): Likewise. (gfc_match_omp_target_teams_distribute_parallel_do): Likewise. (gfc_match_omp_teams_distribute_parallel_do): Likewise. (gfc_match_omp_declare_simd): If not using the form with (proc-name), require space before first clause. Make (proc-name) optional. If not present, set proc_name to NULL. (gfc_match_omp_declare_target): Rewritten for OpenMP 4.5. (gfc_match_omp_single): Use OMP_SINGLE_CLAUSES. (gfc_match_omp_task, gfc_match_omp_taskwait, gfc_match_omp_taskyield): Move around to where they belong alphabetically. (gfc_match_omp_target_enter_data, gfc_match_omp_target_exit_data, gfc_match_omp_target_parallel, gfc_match_omp_target_parallel_do, gfc_match_omp_target_parallel_do_simd, gfc_match_omp_target_simd, gfc_match_omp_taskloop, gfc_match_omp_taskloop_simd): New functions. (gfc_match_omp_ordered): Parse clauses. (gfc_match_omp_ordered_depend): New function. (gfc_match_omp_cancel, gfc_match_omp_end_single): Use omp_mask (OMP_CLAUSE_*) instead of OMP_CLAUSE_*. (resolve_oacc_scalar_int_expr): Renamed to ... (resolve_scalar_int_expr): ... this. Fix up formatting. (resolve_oacc_positive_int_expr): Renamed to ... (resolve_positive_int_expr): ... this. Fix up formatting. (resolve_nonnegative_int_expr): New function. (resolve_omp_clauses): Adjust callers, use the above functions even for OpenMP clauses, add handling of new OpenMP 4.5 clauses. Require orderedc >= collapse if specified. Handle depend(sink:) and depend(source) restrictions. Disallow linear clause when orderedc is non-zero. Diagnose linear clause modifiers when not in declare simd. Only check for integer type if ref modifier is not used. Remove diagnostics for required VALUE attribute. Diagnose VALUE attribute with ref or uval modifiers. Allow non-constant linear-step, if it is a dummy argument alone and is mentioned in uniform clause. Diagnose map kinds not allowed for various constructs. Diagnose target {enter ,exit ,}data without any map clauses. Add dummy OMP_LIST_IS_DEVICE_PTR and OMP_LIST_USE_DEVICE_PTR cases. (gfc_resolve_omp_do_blocks): Set omp_current_do_collapse to orderedc if non-zero. (gfc_resolve_omp_parallel_blocks): Handle new OpenMP 4.5 constructs, replace underscores with spaces in a few construct names. (resolve_omp_do): Set collapse to orderedc if non-zero. Handle new OpenMP 4.5 constructs. (resolve_oacc_loop_blocks): Call resolve_positive_int_expr instead of resolve_oacc_positive_int_expr. (gfc_resolve_omp_directive): Handle new OpenMP 4.5 constructs. (gfc_resolve_omp_declare_simd): Allow ods->proc_name to be NULL. * trans-openmp.c (gfc_omp_scalar_p): New function. (doacross_steps): New variable. (gfc_trans_omp_clauses): Handle new OpenMP 4.5 clauses and new clause modifiers. (gfc_trans_omp_critical): Adjust EXEC_OMP_CRITICAL handling. (gfc_trans_omp_do): Handle doacross loops. Clear sched_simd flag. Handle EXEC_OMP_TASKLOOP. (gfc_trans_omp_ordered): Translate omp clauses, allow NULL code->block. (GFC_OMP_SPLIT_TASKLOOP, GFC_OMP_MASK_TASKLOOP): New enum constants. (gfc_split_omp_clauses): Copy orderedc together with ordered. Change firstprivate and lastprivate handling for OpenMP 4.5. Handle EXEC_OMP_TARGET_SIMD, EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} and EXEC_OMP_TASKLOOP{,_SIMD}. Add handling for new OpenMP 4.5 clauses and clause modifiers and handle if clause without/with modifiers. (gfc_trans_omp_teams): Add omp_clauses argument, add it to other teams clauses. Don't wrap into OMP_TEAMS if -fopenmp-simd. (gfc_trans_omp_target): For -fopenmp, translate num_teams and thread_limit clauses on combined target teams early and pass to gfc_trans_omp_teams. Set OMP_TARGET_COMBINED if needed. Handle EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} and EXEC_OMP_TARGET_SIMD. (gfc_trans_omp_taskloop, gfc_trans_omp_target_enter_data, gfc_trans_omp_target_exit_data): New functions. (gfc_trans_omp_directive): Handle EXEC_OMP_TARGET_{ENTER,EXIT}_DATA EXEC_OMP_TASKLOOP{,_SIMD}, EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} and EXEC_OMP_TARGET_SIMD. Adjust gfc_trans_omp_teams caller. * symbol.c (check_conflict): Handle omp_declare_target_link. (gfc_add_omp_declare_target_link): New function. (gfc_copy_attr): Copy omp_declare_target_link. * dump-parse-tree.c (show_omp_namelist): Handle OMP_DEPEND_SINK_FIRST depend_op. Print linear clause modifiers. (show_omp_clauses): Adjust for OpenMP 4.5 clause changes. (show_omp_node): Print clauses for EXEC_OMP_ORDERED. Allow NULL c->block for EXEC_OMP_ORDERED. Formatting fixes. Adjust handling of EXEC_OMP_CRITICAL, handle new OpenMP 4.5 constructs and some forgotten OpenMP 4.0 constructs. (show_code_node): Handle new OpenMP 4.5 constructs and some forgotten OpenMP 4.0 constructs. * gfortran.h (symbol_attribute): Add omp_declare_target_link bitfield. (struct gfc_omp_namelist): Add u.common and u.linear_op fields. (struct gfc_common_head): Change omp_declare_target into bitfield. Add omp_declare_target_link bitfield. (gfc_add_omp_declare_target_link): New prototype. (enum gfc_statement): Add ST_OMP_TARGET_PARALLEL, ST_OMP_END_TARGET_PARALLEL, ST_OMP_TARGET_PARALLEL_DO, ST_OMP_END_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD, ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA, ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD and ST_OMP_ORDERED_DEPEND. (enum gfc_omp_depend_op): Add OMP_DEPEND_SINK_FIRST and OMP_DEPEND_SINK. (enum gfc_omp_linear_op): New. (struct gfc_omp_clauses): Add critical_name, depend_source, orderedc, defaultmap, nogroup, sched_simd, sched_monotonic, sched_nonmonotonic, simd, threads, grainsize, hint, num_tasks, priority and if_exprs fields. (enum gfc_exec_op): Add EXEC_OMP_END_CRITICAL, EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD. (enum gfc_omp_map_op): Add OMP_MAP_RELEASE, OMP_MAP_ALWAYS_TO, OMP_MAP_ALWAYS_FROM and OMP_MAP_ALWAYS_TOFROM. (OMP_LIST_IS_DEVICE_PTR, OMP_LIST_USE_DEVICE_PTR): New. (enum gfc_omp_if_kind): New. * module.c (enum ab_attribute): Add AB_OMP_DECLARE_TARGET_LINK. (attr_bits): Add AB_OMP_DECLARE_TARGET_LINK entry. (mio_symbol_attribute): Save and restore omp_declare_target_link bit. * trans.h (gfc_omp_scalar_p): New prototype. * frontend-passes.c (gfc_code_walker): Handle new OpenMP 4.5 expressions. * trans.c (trans_code): Handle new OpenMP 4.5 constructs. * resolve.c (gfc_resolve_blocks): Likewise. (gfc_resolve_code): Likewise. * f95-lang.c (LANG_HOOKS_OMP_SCALAR_P): Redefine to gfc_omp_scalar_p. (gfc_attribute_table): Add "omp declare target link". * st.c (gfc_free_statement): Handle EXEC_OMP_END_CRITICAL like EXEC_OMP_CRITICAL before, free clauses for EXEC_OMP_CRITICAL and new OpenMP 4.5 constructs. Free omp clauses even for EXEC_OMP_ORDERED. * match.c (match_exit_cycle): Rename collapse variable to count, set it to orderedc if non-zero, instead of collapse. * trans-decl.c (add_attributes_to_decl): Add "omp declare target link" instead of "omp declare target" for omp_declare_target_link. * trans-common.c (build_common_decl): Likewise. * match.h (gfc_match_omp_target_enter_data, gfc_match_omp_target_exit_data, gfc_match_omp_target_parallel, gfc_match_omp_target_parallel_do, gfc_match_omp_target_parallel_do_simd, gfc_match_omp_target_simd, gfc_match_omp_taskloop, gfc_match_omp_taskloop_simd, gfc_match_omp_end_critical, gfc_match_omp_ordered_depend): New prototypes. * parse.c (decode_omp_directive): Use gfc_match_omp_end_critical instead of gfc_match_omp_critical for !$omp end critical. Handle new OpenMP 4.5 constructs. If ordered directive has depend clause as the first of the clauses, use gfc_match_omp_ordered_depend and ST_OMP_ORDERED_DEPEND instead of gfc_match_omp_ordered and ST_OMP_ORDERED. (case_executable): Add ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA and ST_OMP_ORDERED_DEPEND cases. (case_exec_markers): Add ST_OMP_TARGET_PARALLEL, ST_OMP_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_TARGET_SIMD, ST_OMP_TASKLOOP and ST_OMP_TASKLOOP_SIMD cases. (gfc_ascii_statement): Handle new OpenMP 4.5 constructs. (parse_omp_do): Handle ST_OMP_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_TASKLOOP and ST_OMP_TASKLOOP_SIMD. (parse_omp_structured_block): Handle EXEC_OMP_END_CRITICAL instead of EXEC_OMP_CRITICAL, adjust for EXEC_OMP_CRITICAL having omp clauses now. (parse_executable): Handle ST_OMP_TARGET_PARALLEL, ST_OMP_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_TASKLOOP and ST_OMP_TASKLOOP_SIMD. gcc/testsuite/ * gfortran.dg/gomp/pr77516.f90: Add dg-warning. * gfortran.dg/gomp/target1.f90: Remove ordered clause where it is no longer allowed and corresponding ordered construct. * gfortran.dg/gomp/linear-1.f90: New test. * gfortran.dg/gomp/declare-simd-2.f90: New test. * gfortran.dg/gomp/declare-target-1.f90: New test. * gfortran.dg/gomp/declare-target-2.f90: New test. libgomp/ * testsuite/libgomp.fortran/examples-4/declare_target-1.f90 (fib_wrapper): Add map(from: x) clause. * testsuite/libgomp.fortran/examples-4/declare_target-2.f90 (e_53_2): Likewise. * testsuite/libgomp.fortran/examples-4/declare_target-4.f90 (accum): Add map(tmp) clause. * testsuite/libgomp.fortran/examples-4/declare_target-5.f90 (accum): Add map(tofrom: tmp) clause. * testsuite/libgomp.fortran/examples-4/target_data-3.f90 (gramSchmidt): Likewise. * testsuite/libgomp.fortran/examples-4/teams-2.f90 (dotprod): Add map(tofrom: sum) clause. * testsuite/libgomp.fortran/nestedfn5.f90 (foo): Add twice map (alloc: a, l) clause. Add defaultmap(tofrom: scalar) clause. * testsuite/libgomp.fortran/pr66199-2.f90: Adjust for linear clause only allowed on the loop iterator. * testsuite/libgomp.fortran/target4.f90 (foo): Add map(t) clause. * testsuite/libgomp.fortran/taskloop2.f90: New test. * testsuite/libgomp.fortran/taskloop4.f90: New test. * testsuite/libgomp.fortran/doacross1.f90: New test. * testsuite/libgomp.fortran/doacross3.f90: New test. * testsuite/libgomp.fortran/taskloop1.f90: New test. * testsuite/libgomp.fortran/taskloop3.f90: New test. * testsuite/libgomp.fortran/doacross2.f90: New test. * testsuite/libgomp.c/doacross-1.c (main): Add missing #pragma omp atomic read. * testsuite/libgomp.c/doacross-2.c (main): Likewise. * testsuite/libgomp.c/doacross-3.c (main): Likewise. From-SVN: r242037
Diffstat (limited to 'gcc/fortran/openmp.c')
-rw-r--r--gcc/fortran/openmp.c1580
1 files changed, 1264 insertions, 316 deletions
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 03e7dbe..11ffb5d 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -76,6 +76,12 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->device);
gfc_free_expr (c->thread_limit);
gfc_free_expr (c->dist_chunk_size);
+ gfc_free_expr (c->grainsize);
+ gfc_free_expr (c->hint);
+ gfc_free_expr (c->num_tasks);
+ gfc_free_expr (c->priority);
+ for (i = 0; i < OMP_IF_LAST; i++)
+ gfc_free_expr (c->if_exprs[i]);
gfc_free_expr (c->async_expr);
gfc_free_expr (c->gang_num_expr);
gfc_free_expr (c->gang_static_expr);
@@ -88,6 +94,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_omp_namelist (c->lists[i]);
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
+ free (CONST_CAST (char *, c->critical_name));
free (c);
}
@@ -333,6 +340,170 @@ cleanup:
return MATCH_ERROR;
}
+/* Match a variable/procedure/common block list and construct a namelist
+ from it. */
+
+static match
+gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list)
+{
+ gfc_omp_namelist *head, *tail, *p;
+ locus old_loc, cur_loc;
+ char n[GFC_MAX_SYMBOL_LEN+1];
+ gfc_symbol *sym;
+ match m;
+ gfc_symtree *st;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ for (;;)
+ {
+ cur_loc = gfc_current_locus;
+ m = gfc_match_symbol (&sym, 1);
+ switch (m)
+ {
+ case MATCH_YES:
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->sym = sym;
+ tail->where = cur_loc;
+ goto next_item;
+ case MATCH_NO:
+ break;
+ case MATCH_ERROR:
+ goto cleanup;
+ }
+
+ m = gfc_match (" / %n /", n);
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ if (m == MATCH_NO)
+ goto syntax;
+
+ st = gfc_find_symtree (gfc_current_ns->common_root, n);
+ if (st == NULL)
+ {
+ gfc_error ("COMMON block /%s/ not found at %C", n);
+ goto cleanup;
+ }
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->u.common = st->n.common;
+ tail->where = cur_loc;
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenMP variable list at %C");
+
+cleanup:
+ gfc_free_omp_namelist (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
+/* Match depend(sink : ...) construct a namelist from it. */
+
+static match
+gfc_match_omp_depend_sink (gfc_omp_namelist **list)
+{
+ gfc_omp_namelist *head, *tail, *p;
+ locus old_loc, cur_loc;
+ gfc_symbol *sym;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ for (;;)
+ {
+ cur_loc = gfc_current_locus;
+ switch (gfc_match_symbol (&sym, 1))
+ {
+ case MATCH_YES:
+ gfc_set_sym_referenced (sym);
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ {
+ head = tail = p;
+ head->u.depend_op = OMP_DEPEND_SINK_FIRST;
+ }
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ tail->u.depend_op = OMP_DEPEND_SINK;
+ }
+ tail->sym = sym;
+ tail->expr = NULL;
+ tail->where = cur_loc;
+ if (gfc_match_char ('+') == MATCH_YES)
+ {
+ if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
+ goto syntax;
+ }
+ else if (gfc_match_char ('-') == MATCH_YES)
+ {
+ if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
+ goto syntax;
+ tail->expr = gfc_uminus (tail->expr);
+ }
+ break;
+ case MATCH_NO:
+ goto syntax;
+ case MATCH_ERROR:
+ goto cleanup;
+ }
+
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
+
+cleanup:
+ gfc_free_omp_namelist (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
static match
match_oacc_expr_list (const char *str, gfc_expr_list **list,
bool allow_asterisk)
@@ -563,67 +734,183 @@ cleanup:
return MATCH_ERROR;
}
-#define OMP_CLAUSE_PRIVATE ((uint64_t) 1 << 0)
-#define OMP_CLAUSE_FIRSTPRIVATE ((uint64_t) 1 << 1)
-#define OMP_CLAUSE_LASTPRIVATE ((uint64_t) 1 << 2)
-#define OMP_CLAUSE_COPYPRIVATE ((uint64_t) 1 << 3)
-#define OMP_CLAUSE_SHARED ((uint64_t) 1 << 4)
-#define OMP_CLAUSE_COPYIN ((uint64_t) 1 << 5)
-#define OMP_CLAUSE_REDUCTION ((uint64_t) 1 << 6)
-#define OMP_CLAUSE_IF ((uint64_t) 1 << 7)
-#define OMP_CLAUSE_NUM_THREADS ((uint64_t) 1 << 8)
-#define OMP_CLAUSE_SCHEDULE ((uint64_t) 1 << 9)
-#define OMP_CLAUSE_DEFAULT ((uint64_t) 1 << 10)
-#define OMP_CLAUSE_ORDERED ((uint64_t) 1 << 11)
-#define OMP_CLAUSE_COLLAPSE ((uint64_t) 1 << 12)
-#define OMP_CLAUSE_UNTIED ((uint64_t) 1 << 13)
-#define OMP_CLAUSE_FINAL ((uint64_t) 1 << 14)
-#define OMP_CLAUSE_MERGEABLE ((uint64_t) 1 << 15)
-#define OMP_CLAUSE_ALIGNED ((uint64_t) 1 << 16)
-#define OMP_CLAUSE_DEPEND ((uint64_t) 1 << 17)
-#define OMP_CLAUSE_INBRANCH ((uint64_t) 1 << 18)
-#define OMP_CLAUSE_LINEAR ((uint64_t) 1 << 19)
-#define OMP_CLAUSE_NOTINBRANCH ((uint64_t) 1 << 20)
-#define OMP_CLAUSE_PROC_BIND ((uint64_t) 1 << 21)
-#define OMP_CLAUSE_SAFELEN ((uint64_t) 1 << 22)
-#define OMP_CLAUSE_SIMDLEN ((uint64_t) 1 << 23)
-#define OMP_CLAUSE_UNIFORM ((uint64_t) 1 << 24)
-#define OMP_CLAUSE_DEVICE ((uint64_t) 1 << 25)
-#define OMP_CLAUSE_MAP ((uint64_t) 1 << 26)
-#define OMP_CLAUSE_TO ((uint64_t) 1 << 27)
-#define OMP_CLAUSE_FROM ((uint64_t) 1 << 28)
-#define OMP_CLAUSE_NUM_TEAMS ((uint64_t) 1 << 29)
-#define OMP_CLAUSE_THREAD_LIMIT ((uint64_t) 1 << 30)
-#define OMP_CLAUSE_DIST_SCHEDULE ((uint64_t) 1 << 31)
-
-/* OpenACC 2.0 clauses. */
-#define OMP_CLAUSE_ASYNC ((uint64_t) 1 << 32)
-#define OMP_CLAUSE_NUM_GANGS ((uint64_t) 1 << 33)
-#define OMP_CLAUSE_NUM_WORKERS ((uint64_t) 1 << 34)
-#define OMP_CLAUSE_VECTOR_LENGTH ((uint64_t) 1 << 35)
-#define OMP_CLAUSE_COPY ((uint64_t) 1 << 36)
-#define OMP_CLAUSE_COPYOUT ((uint64_t) 1 << 37)
-#define OMP_CLAUSE_CREATE ((uint64_t) 1 << 38)
-#define OMP_CLAUSE_PRESENT ((uint64_t) 1 << 39)
-#define OMP_CLAUSE_PRESENT_OR_COPY ((uint64_t) 1 << 40)
-#define OMP_CLAUSE_PRESENT_OR_COPYIN ((uint64_t) 1 << 41)
-#define OMP_CLAUSE_PRESENT_OR_COPYOUT ((uint64_t) 1 << 42)
-#define OMP_CLAUSE_PRESENT_OR_CREATE ((uint64_t) 1 << 43)
-#define OMP_CLAUSE_DEVICEPTR ((uint64_t) 1 << 44)
-#define OMP_CLAUSE_GANG ((uint64_t) 1 << 45)
-#define OMP_CLAUSE_WORKER ((uint64_t) 1 << 46)
-#define OMP_CLAUSE_VECTOR ((uint64_t) 1 << 47)
-#define OMP_CLAUSE_SEQ ((uint64_t) 1 << 48)
-#define OMP_CLAUSE_INDEPENDENT ((uint64_t) 1 << 49)
-#define OMP_CLAUSE_USE_DEVICE ((uint64_t) 1 << 50)
-#define OMP_CLAUSE_DEVICE_RESIDENT ((uint64_t) 1 << 51)
-#define OMP_CLAUSE_HOST_SELF ((uint64_t) 1 << 52)
-#define OMP_CLAUSE_OACC_DEVICE ((uint64_t) 1 << 53)
-#define OMP_CLAUSE_WAIT ((uint64_t) 1 << 54)
-#define OMP_CLAUSE_DELETE ((uint64_t) 1 << 55)
-#define OMP_CLAUSE_AUTO ((uint64_t) 1 << 56)
-#define OMP_CLAUSE_TILE ((uint64_t) 1 << 57)
-#define OMP_CLAUSE_LINK ((uint64_t) 1 << 58)
+/* OpenMP 4.5 clauses. */
+enum omp_mask1
+{
+ OMP_CLAUSE_PRIVATE,
+ OMP_CLAUSE_FIRSTPRIVATE,
+ OMP_CLAUSE_LASTPRIVATE,
+ OMP_CLAUSE_COPYPRIVATE,
+ OMP_CLAUSE_SHARED,
+ OMP_CLAUSE_COPYIN,
+ OMP_CLAUSE_REDUCTION,
+ OMP_CLAUSE_IF,
+ OMP_CLAUSE_NUM_THREADS,
+ OMP_CLAUSE_SCHEDULE,
+ OMP_CLAUSE_DEFAULT,
+ OMP_CLAUSE_ORDERED,
+ OMP_CLAUSE_COLLAPSE,
+ OMP_CLAUSE_UNTIED,
+ OMP_CLAUSE_FINAL,
+ OMP_CLAUSE_MERGEABLE,
+ OMP_CLAUSE_ALIGNED,
+ OMP_CLAUSE_DEPEND,
+ OMP_CLAUSE_INBRANCH,
+ OMP_CLAUSE_LINEAR,
+ OMP_CLAUSE_NOTINBRANCH,
+ OMP_CLAUSE_PROC_BIND,
+ OMP_CLAUSE_SAFELEN,
+ OMP_CLAUSE_SIMDLEN,
+ OMP_CLAUSE_UNIFORM,
+ OMP_CLAUSE_DEVICE,
+ OMP_CLAUSE_MAP,
+ OMP_CLAUSE_TO,
+ OMP_CLAUSE_FROM,
+ OMP_CLAUSE_NUM_TEAMS,
+ OMP_CLAUSE_THREAD_LIMIT,
+ OMP_CLAUSE_DIST_SCHEDULE,
+ OMP_CLAUSE_DEFAULTMAP,
+ OMP_CLAUSE_GRAINSIZE,
+ OMP_CLAUSE_HINT,
+ OMP_CLAUSE_IS_DEVICE_PTR,
+ OMP_CLAUSE_LINK,
+ OMP_CLAUSE_NOGROUP,
+ OMP_CLAUSE_NUM_TASKS,
+ OMP_CLAUSE_PRIORITY,
+ OMP_CLAUSE_SIMD,
+ OMP_CLAUSE_THREADS,
+ OMP_CLAUSE_USE_DEVICE_PTR,
+ OMP_CLAUSE_NOWAIT,
+ /* This must come last. */
+ OMP_MASK1_LAST
+};
+
+/* OpenACC 2.0 specific clauses. */
+enum omp_mask2
+{
+ OMP_CLAUSE_ASYNC,
+ OMP_CLAUSE_NUM_GANGS,
+ OMP_CLAUSE_NUM_WORKERS,
+ OMP_CLAUSE_VECTOR_LENGTH,
+ OMP_CLAUSE_COPY,
+ OMP_CLAUSE_COPYOUT,
+ OMP_CLAUSE_CREATE,
+ OMP_CLAUSE_PRESENT,
+ OMP_CLAUSE_PRESENT_OR_COPY,
+ OMP_CLAUSE_PRESENT_OR_COPYIN,
+ OMP_CLAUSE_PRESENT_OR_COPYOUT,
+ OMP_CLAUSE_PRESENT_OR_CREATE,
+ OMP_CLAUSE_DEVICEPTR,
+ OMP_CLAUSE_GANG,
+ OMP_CLAUSE_WORKER,
+ OMP_CLAUSE_VECTOR,
+ OMP_CLAUSE_SEQ,
+ OMP_CLAUSE_INDEPENDENT,
+ OMP_CLAUSE_USE_DEVICE,
+ OMP_CLAUSE_DEVICE_RESIDENT,
+ OMP_CLAUSE_HOST_SELF,
+ OMP_CLAUSE_WAIT,
+ OMP_CLAUSE_DELETE,
+ OMP_CLAUSE_AUTO,
+ OMP_CLAUSE_TILE,
+ /* This must come last. */
+ OMP_MASK2_LAST
+};
+
+struct omp_inv_mask;
+
+/* Customized bitset for up to 128-bits.
+ The two enums above provide bit numbers to use, and which of the
+ two enums it is determines which of the two mask fields is used.
+ Supported operations are defining a mask, like:
+ #define XXX_CLAUSES \
+ (omp_mask (OMP_CLAUSE_XXX) | OMP_CLAUSE_YYY | OMP_CLAUSE_ZZZ)
+ oring such bitsets together or removing selected bits:
+ (XXX_CLAUSES | YYY_CLAUSES) & ~(omp_mask (OMP_CLAUSE_VVV))
+ and testing individual bits:
+ if (mask & OMP_CLAUSE_UUU) */
+
+struct omp_mask {
+ const uint64_t mask1;
+ const uint64_t mask2;
+ inline omp_mask ();
+ inline omp_mask (omp_mask1);
+ inline omp_mask (omp_mask2);
+ inline omp_mask (uint64_t, uint64_t);
+ inline omp_mask operator| (omp_mask1) const;
+ inline omp_mask operator| (omp_mask2) const;
+ inline omp_mask operator| (omp_mask) const;
+ inline omp_mask operator& (const omp_inv_mask &) const;
+ inline bool operator& (omp_mask1) const;
+ inline bool operator& (omp_mask2) const;
+ inline omp_inv_mask operator~ () const;
+};
+
+struct omp_inv_mask : public omp_mask {
+ inline omp_inv_mask (const omp_mask &);
+};
+
+omp_mask::omp_mask () : mask1 (0), mask2 (0)
+{
+}
+
+omp_mask::omp_mask (omp_mask1 m) : mask1 (((uint64_t) 1) << m), mask2 (0)
+{
+}
+
+omp_mask::omp_mask (omp_mask2 m) : mask1 (0), mask2 (((uint64_t) 1) << m)
+{
+}
+
+omp_mask::omp_mask (uint64_t m1, uint64_t m2) : mask1 (m1), mask2 (m2)
+{
+}
+
+omp_mask
+omp_mask::operator| (omp_mask1 m) const
+{
+ return omp_mask (mask1 | (((uint64_t) 1) << m), mask2);
+}
+
+omp_mask
+omp_mask::operator| (omp_mask2 m) const
+{
+ return omp_mask (mask1, mask2 | (((uint64_t) 1) << m));
+}
+
+omp_mask
+omp_mask::operator| (omp_mask m) const
+{
+ return omp_mask (mask1 | m.mask1, mask2 | m.mask2);
+}
+
+omp_mask
+omp_mask::operator& (const omp_inv_mask &m) const
+{
+ return omp_mask (mask1 & ~m.mask1, mask2 & ~m.mask2);
+}
+
+bool
+omp_mask::operator& (omp_mask1 m) const
+{
+ return (mask1 & (((uint64_t) 1) << m)) != 0;
+}
+
+bool
+omp_mask::operator& (omp_mask2 m) const
+{
+ return (mask2 & (((uint64_t) 1) << m)) != 0;
+}
+
+omp_inv_mask
+omp_mask::operator~ () const
+{
+ return omp_inv_mask (*this);
+}
+
+omp_inv_mask::omp_inv_mask (const omp_mask &m) : omp_mask (m)
+{
+}
/* Helper function for OpenACC and OpenMP clauses involving memory
mapping. */
@@ -648,13 +935,14 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op)
clauses that are allowed for a particular directive. */
static match
-gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
+gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
bool first = true, bool needs_space = true,
bool openacc = false)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
+ gcc_checking_assert (OMP_MASK1_LAST <= 64 && OMP_MASK2_LAST <= 64);
*cp = NULL;
while (1)
{
@@ -790,11 +1078,6 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
continue;
break;
case 'd':
- if ((mask & OMP_CLAUSE_DELETE)
- && gfc_match ("delete ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_DELETE))
- continue;
if ((mask & OMP_CLAUSE_DEFAULT)
&& c->default_sharing == OMP_DEFAULT_UNKNOWN)
{
@@ -811,6 +1094,18 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
continue;
}
+ if ((mask & OMP_CLAUSE_DEFAULTMAP)
+ && !c->defaultmap
+ && gfc_match ("defaultmap ( tofrom : scalar )") == MATCH_YES)
+ {
+ c->defaultmap = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_DELETE)
+ && gfc_match ("delete ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_DELETE))
+ continue;
if ((mask & OMP_CLAUSE_DEPEND)
&& gfc_match ("depend ( ") == MATCH_YES)
{
@@ -822,6 +1117,19 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
depend_op = OMP_DEPEND_IN;
else if (gfc_match ("out") == MATCH_YES)
depend_op = OMP_DEPEND_OUT;
+ else if (!c->depend_source
+ && gfc_match ("source )") == MATCH_YES)
+ {
+ c->depend_source = true;
+ continue;
+ }
+ else if (gfc_match ("sink : ") == MATCH_YES)
+ {
+ if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND])
+ == MATCH_YES)
+ continue;
+ m = MATCH_NO;
+ }
else
m = MATCH_NO;
head = NULL;
@@ -840,10 +1148,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
gfc_current_locus = old_loc;
}
if ((mask & OMP_CLAUSE_DEVICE)
+ && !openacc
&& c->device == NULL
&& gfc_match ("device ( %e )", &c->device) == MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_OACC_DEVICE)
+ if ((mask & OMP_CLAUSE_DEVICE)
+ && openacc
&& gfc_match ("device ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FORCE_TO))
@@ -917,8 +1227,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
needs_space = true;
continue;
}
+ if ((mask & OMP_CLAUSE_GRAINSIZE)
+ && c->grainsize == NULL
+ && gfc_match ("grainsize ( %e )", &c->grainsize) == MATCH_YES)
+ continue;
break;
case 'h':
+ if ((mask & OMP_CLAUSE_HINT)
+ && c->hint == NULL
+ && gfc_match ("hint ( %e )", &c->hint) == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_HOST_SELF)
&& gfc_match ("host ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -928,8 +1246,32 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
case 'i':
if ((mask & OMP_CLAUSE_IF)
&& c->if_expr == NULL
- && gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
- continue;
+ && gfc_match ("if ( ") == MATCH_YES)
+ {
+ if (gfc_match ("%e )", &c->if_expr) == MATCH_YES)
+ continue;
+ if (!openacc)
+ {
+ /* This should match the enum gfc_omp_if_kind order. */
+ static const char *ifs[OMP_IF_LAST] = {
+ " parallel : %e )",
+ " task : %e )",
+ " taskloop : %e )",
+ " target : %e )",
+ " target data : %e )",
+ " target update : %e )",
+ " target enter data : %e )",
+ " target exit data : %e )" };
+ int i;
+ for (i = 0; i < OMP_IF_LAST; i++)
+ if (c->if_exprs[i] == NULL
+ && gfc_match (ifs[i], &c->if_exprs[i]) == MATCH_YES)
+ break;
+ if (i < OMP_IF_LAST)
+ continue;
+ }
+ gfc_current_locus = old_loc;
+ }
if ((mask & OMP_CLAUSE_INBRANCH)
&& !c->inbranch
&& !c->notinbranch
@@ -946,6 +1288,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
needs_space = true;
continue;
}
+ if ((mask & OMP_CLAUSE_IS_DEVICE_PTR)
+ && gfc_match_omp_variable_list
+ ("is_device_ptr (",
+ &c->lists[OMP_LIST_IS_DEVICE_PTR], false) == MATCH_YES)
+ continue;
break;
case 'l':
if ((mask & OMP_CLAUSE_LASTPRIVATE)
@@ -956,13 +1303,50 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
end_colon = false;
head = NULL;
if ((mask & OMP_CLAUSE_LINEAR)
- && gfc_match_omp_variable_list ("linear (",
- &c->lists[OMP_LIST_LINEAR],
- false, &end_colon,
- &head) == MATCH_YES)
+ && gfc_match ("linear (") == MATCH_YES)
{
+ gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
gfc_expr *step = NULL;
+ if (gfc_match_omp_variable_list (" ref (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_REF;
+ else if (gfc_match_omp_variable_list (" val (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_VAL;
+ else if (gfc_match_omp_variable_list (" uval (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_UVAL;
+ else if (gfc_match_omp_variable_list ("",
+ &c->lists[OMP_LIST_LINEAR],
+ false, &end_colon, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_DEFAULT;
+ else
+ {
+ gfc_free_omp_namelist (*head);
+ gfc_current_locus = old_loc;
+ *head = NULL;
+ break;
+ }
+ if (linear_op != OMP_LINEAR_DEFAULT)
+ {
+ if (gfc_match (" :") == MATCH_YES)
+ end_colon = true;
+ else if (gfc_match (" )") != MATCH_YES)
+ {
+ gfc_free_omp_namelist (*head);
+ gfc_current_locus = old_loc;
+ *head = NULL;
+ break;
+ }
+ }
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
{
gfc_free_omp_namelist (*head);
@@ -978,27 +1362,50 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
mpz_set_si (step->value.integer, 1);
}
(*head)->expr = step;
+ if (linear_op != OMP_LINEAR_DEFAULT)
+ for (gfc_omp_namelist *n = *head; n; n = n->next)
+ n->u.linear_op = linear_op;
continue;
}
if ((mask & OMP_CLAUSE_LINK)
+ && openacc
&& (gfc_match_oacc_clause_link ("link (",
&c->lists[OMP_LIST_LINK])
== MATCH_YES))
continue;
+ else if ((mask & OMP_CLAUSE_LINK)
+ && !openacc
+ && (gfc_match_omp_to_link ("link (",
+ &c->lists[OMP_LIST_LINK])
+ == MATCH_YES))
+ continue;
break;
case 'm':
if ((mask & OMP_CLAUSE_MAP)
&& gfc_match ("map ( ") == MATCH_YES)
{
+ locus old_loc2 = gfc_current_locus;
+ bool always = false;
gfc_omp_map_op map_op = OMP_MAP_TOFROM;
+ if (gfc_match ("always , ") == MATCH_YES)
+ always = true;
if (gfc_match ("alloc : ") == MATCH_YES)
map_op = OMP_MAP_ALLOC;
else if (gfc_match ("tofrom : ") == MATCH_YES)
- map_op = OMP_MAP_TOFROM;
+ map_op = always ? OMP_MAP_ALWAYS_TOFROM : OMP_MAP_TOFROM;
else if (gfc_match ("to : ") == MATCH_YES)
- map_op = OMP_MAP_TO;
+ map_op = always ? OMP_MAP_ALWAYS_TO : OMP_MAP_TO;
else if (gfc_match ("from : ") == MATCH_YES)
- map_op = OMP_MAP_FROM;
+ map_op = always ? OMP_MAP_ALWAYS_FROM : OMP_MAP_FROM;
+ else if (gfc_match ("release : ") == MATCH_YES)
+ map_op = OMP_MAP_RELEASE;
+ else if (gfc_match ("delete : ") == MATCH_YES)
+ map_op = OMP_MAP_DELETE;
+ else if (always)
+ {
+ gfc_current_locus = old_loc2;
+ always = false;
+ }
head = NULL;
if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
false, NULL, &head,
@@ -1020,6 +1427,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
}
break;
case 'n':
+ if ((mask & OMP_CLAUSE_NOGROUP)
+ && !c->nogroup
+ && gfc_match ("nogroup") == MATCH_YES)
+ {
+ c->nogroup = needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_NOTINBRANCH)
&& !c->notinbranch
&& !c->inbranch
@@ -1028,11 +1442,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
c->notinbranch = needs_space = true;
continue;
}
+ if ((mask & OMP_CLAUSE_NOWAIT)
+ && !c->nowait
+ && gfc_match ("nowait") == MATCH_YES)
+ {
+ c->nowait = needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_NUM_GANGS)
&& c->num_gangs_expr == NULL
&& gfc_match ("num_gangs ( %e )",
&c->num_gangs_expr) == MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_NUM_TASKS)
+ && c->num_tasks == NULL
+ && gfc_match ("num_tasks ( %e )", &c->num_tasks) == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_NUM_TEAMS)
&& c->num_teams == NULL
&& gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES)
@@ -1053,7 +1478,31 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& !c->ordered
&& gfc_match ("ordered") == MATCH_YES)
{
- c->ordered = needs_space = true;
+ gfc_expr *cexpr = NULL;
+ match m = gfc_match (" ( %e )", &cexpr);
+
+ c->ordered = true;
+ if (m == MATCH_YES)
+ {
+ int ordered = 0;
+ const char *p = gfc_extract_int (cexpr, &ordered);
+ if (p)
+ {
+ gfc_error_now (p);
+ ordered = 0;
+ }
+ else if (ordered <= 0)
+ {
+ gfc_error_now ("ORDERED clause argument not"
+ " constant positive integer at %C");
+ ordered = 0;
+ }
+ c->orderedc = ordered;
+ gfc_free_expr (cexpr);
+ continue;
+ }
+
+ needs_space = true;
continue;
}
break;
@@ -1103,6 +1552,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_ALLOC))
continue;
+ if ((mask & OMP_CLAUSE_PRIORITY)
+ && c->priority == NULL
+ && gfc_match ("priority ( %e )", &c->priority) == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_PRIVATE)
&& gfc_match_omp_variable_list ("private (",
&c->lists[OMP_LIST_PRIVATE],
@@ -1252,6 +1705,45 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& c->sched_kind == OMP_SCHED_NONE
&& gfc_match ("schedule ( ") == MATCH_YES)
{
+ int nmodifiers = 0;
+ locus old_loc2 = gfc_current_locus;
+ do
+ {
+ if (!c->sched_simd
+ && gfc_match ("simd") == MATCH_YES)
+ {
+ c->sched_simd = true;
+ nmodifiers++;
+ }
+ else if (!c->sched_monotonic
+ && !c->sched_nonmonotonic
+ && gfc_match ("monotonic") == MATCH_YES)
+ {
+ c->sched_monotonic = true;
+ nmodifiers++;
+ }
+ else if (!c->sched_monotonic
+ && !c->sched_nonmonotonic
+ && gfc_match ("nonmonotonic") == MATCH_YES)
+ {
+ c->sched_nonmonotonic = true;
+ nmodifiers++;
+ }
+ else
+ {
+ if (nmodifiers)
+ gfc_current_locus = old_loc2;
+ break;
+ }
+ if (nmodifiers == 0
+ && gfc_match (" , ") == MATCH_YES)
+ continue;
+ else if (gfc_match (" : ") == MATCH_YES)
+ break;
+ gfc_current_locus = old_loc2;
+ break;
+ }
+ while (1);
if (gfc_match ("static") == MATCH_YES)
c->sched_kind = OMP_SCHED_STATIC;
else if (gfc_match ("dynamic") == MATCH_YES)
@@ -1300,6 +1792,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& c->simdlen_expr == NULL
&& gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_SIMD)
+ && !c->simd
+ && gfc_match ("simd") == MATCH_YES)
+ {
+ c->simd = needs_space = true;
+ continue;
+ }
break;
case 't':
if ((mask & OMP_CLAUSE_THREAD_LIMIT)
@@ -1307,12 +1806,25 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match ("thread_limit ( %e )",
&c->thread_limit) == MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_THREADS)
+ && !c->threads
+ && gfc_match ("threads") == MATCH_YES)
+ {
+ c->threads = needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_TILE)
&& !c->tile_list
&& match_oacc_expr_list ("tile (", &c->tile_list,
true) == MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_TO)
+ if ((mask & OMP_CLAUSE_TO) && (mask & OMP_CLAUSE_LINK))
+ {
+ if (gfc_match_omp_to_link ("to (", &c->lists[OMP_LIST_TO])
+ == MATCH_YES)
+ continue;
+ }
+ else if ((mask & OMP_CLAUSE_TO)
&& gfc_match_omp_variable_list ("to (",
&c->lists[OMP_LIST_TO], false,
NULL, &head, true) == MATCH_YES)
@@ -1336,6 +1848,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&c->lists[OMP_LIST_USE_DEVICE],
true) == MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_USE_DEVICE_PTR)
+ && gfc_match_omp_variable_list
+ ("use_device_ptr (",
+ &c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES)
+ continue;
break;
case 'v':
/* VECTOR_LENGTH must be matched before VECTOR, because the latter
@@ -1409,59 +1926,60 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
#define OACC_PARALLEL_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
| OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
- | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \
| OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
#define OACC_KERNELS_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
- | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
- | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
#define OACC_DATA_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
- | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
- | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
- | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
+ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE)
#define OACC_LOOP_CLAUSES \
- (OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \
- | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \
- | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \
+ (omp_mask (OMP_CLAUSE_COLLAPSE) | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \
+ | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \
+ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \
| OMP_CLAUSE_TILE)
#define OACC_PARALLEL_LOOP_CLAUSES \
(OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES)
#define OACC_KERNELS_LOOP_CLAUSES \
(OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
-#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE
+#define OACC_HOST_DATA_CLAUSES omp_mask (OMP_CLAUSE_USE_DEVICE)
#define OACC_DECLARE_CLAUSES \
- (OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
+ (omp_mask (OMP_CLAUSE_COPY) | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \
- | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
- | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_LINK)
#define OACC_UPDATE_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \
- | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT)
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \
+ | OMP_CLAUSE_DEVICE | OMP_CLAUSE_WAIT)
#define OACC_ENTER_DATA_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYIN \
- | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT \
+ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
| OMP_CLAUSE_PRESENT_OR_CREATE)
#define OACC_EXIT_DATA_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYOUT \
- | OMP_CLAUSE_DELETE)
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT \
+ | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_DELETE)
#define OACC_WAIT_CLAUSES \
- (OMP_CLAUSE_ASYNC)
+ omp_mask (OMP_CLAUSE_ASYNC)
#define OACC_ROUTINE_CLAUSES \
- (OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ)
+ (omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR \
+ | OMP_CLAUSE_SEQ)
static match
-match_acc (gfc_exec_op op, uint64_t mask)
+match_acc (gfc_exec_op op, const omp_mask mask)
{
gfc_omp_clauses *c;
if (gfc_match_omp_clauses (&c, mask, false, false, true) != MATCH_YES)
@@ -1853,44 +2371,71 @@ cleanup:
#define OMP_PARALLEL_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
- | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PROC_BIND)
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \
+ | OMP_CLAUSE_PROC_BIND)
#define OMP_DECLARE_SIMD_CLAUSES \
- (OMP_CLAUSE_SIMDLEN | OMP_CLAUSE_LINEAR | OMP_CLAUSE_UNIFORM \
- | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH | OMP_CLAUSE_NOTINBRANCH)
+ (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \
+ | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \
+ | OMP_CLAUSE_NOTINBRANCH)
#define OMP_DO_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
+ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \
+ | OMP_CLAUSE_LINEAR)
#define OMP_SECTIONS_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
#define OMP_SIMD_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN | OMP_CLAUSE_LINEAR \
- | OMP_CLAUSE_ALIGNED)
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \
+ | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \
+ | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_SIMDLEN)
#define OMP_TASK_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
- | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_DEPEND)
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \
+ | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \
+ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY)
+#define OMP_TASKLOOP_CLAUSES \
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \
+ | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \
+ | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP)
#define OMP_TARGET_CLAUSES \
- (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF)
+ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \
+ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \
+ | OMP_CLAUSE_IS_DEVICE_PTR)
#define OMP_TARGET_DATA_CLAUSES \
- (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF)
+ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_USE_DEVICE_PTR)
+#define OMP_TARGET_ENTER_DATA_CLAUSES \
+ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
+#define OMP_TARGET_EXIT_DATA_CLAUSES \
+ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
#define OMP_TARGET_UPDATE_CLAUSES \
- (OMP_CLAUSE_DEVICE | OMP_CLAUSE_IF | OMP_CLAUSE_TO | OMP_CLAUSE_FROM)
+ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_IF | OMP_CLAUSE_TO \
+ | OMP_CLAUSE_FROM | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
#define OMP_TEAMS_CLAUSES \
- (OMP_CLAUSE_NUM_TEAMS | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_DEFAULT \
- | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_REDUCTION)
+ (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \
+ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION)
#define OMP_DISTRIBUTE_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_COLLAPSE \
- | OMP_CLAUSE_DIST_SCHEDULE)
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE)
+#define OMP_SINGLE_CLAUSES \
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
+#define OMP_ORDERED_CLAUSES \
+ (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
+#define OMP_DECLARE_TARGET_CLAUSES \
+ (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK)
static match
-match_omp (gfc_exec_op op, unsigned int mask)
+match_omp (gfc_exec_op op, const omp_mask mask)
{
gfc_omp_clauses *c;
if (gfc_match_omp_clauses (&c, mask) != MATCH_YES)
@@ -1905,6 +2450,32 @@ match
gfc_match_omp_critical (void)
{
char n[GFC_MAX_SYMBOL_LEN+1];
+ gfc_omp_clauses *c = NULL;
+
+ if (gfc_match (" ( %n )", n) != MATCH_YES)
+ {
+ n[0] = '\0';
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C");
+ return MATCH_ERROR;
+ }
+ }
+ else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_HINT)) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OMP_CRITICAL;
+ new_st.ext.omp_clauses = c;
+ if (n[0])
+ c->critical_name = xstrdup (n);
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_end_critical (void)
+{
+ char n[GFC_MAX_SYMBOL_LEN+1];
if (gfc_match (" ( %n )", n) != MATCH_YES)
n[0] = '\0';
@@ -1913,7 +2484,8 @@ gfc_match_omp_critical (void)
gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C");
return MATCH_ERROR;
}
- new_st.op = EXEC_OMP_CRITICAL;
+
+ new_st.op = EXEC_OMP_END_CRITICAL;
new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL;
return MATCH_YES;
}
@@ -1930,8 +2502,10 @@ match
gfc_match_omp_distribute_parallel_do (void)
{
return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO,
- OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
- | OMP_DO_CLAUSES);
+ (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
+ | OMP_DO_CLAUSES)
+ & ~(omp_mask (OMP_CLAUSE_ORDERED))
+ & ~(omp_mask (OMP_CLAUSE_LINEAR)));
}
@@ -1941,7 +2515,7 @@ gfc_match_omp_distribute_parallel_do_simd (void)
return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD,
(OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
| OMP_DO_CLAUSES | OMP_SIMD_CLAUSES)
- & ~OMP_CLAUSE_ORDERED);
+ & ~(omp_mask (OMP_CLAUSE_ORDERED)));
}
@@ -1963,8 +2537,7 @@ gfc_match_omp_do (void)
match
gfc_match_omp_do_simd (void)
{
- return match_omp (EXEC_OMP_DO_SIMD, ((OMP_DO_CLAUSES | OMP_SIMD_CLAUSES)
- & ~OMP_CLAUSE_ORDERED));
+ return match_omp (EXEC_OMP_DO_SIMD, OMP_DO_CLAUSES | OMP_SIMD_CLAUSES);
}
@@ -1992,12 +2565,17 @@ gfc_match_omp_declare_simd (void)
gfc_symbol *proc_name;
gfc_omp_clauses *c;
gfc_omp_declare_simd *ods;
+ bool needs_space = false;
- if (gfc_match (" ( %s ) ", &proc_name) != MATCH_YES)
- return MATCH_ERROR;
+ switch (gfc_match (" ( %s ) ", &proc_name))
+ {
+ case MATCH_YES: break;
+ case MATCH_NO: proc_name = NULL; needs_space = true; break;
+ case MATCH_ERROR: return MATCH_ERROR;
+ }
if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true,
- false) != MATCH_YES)
+ needs_space) != MATCH_YES)
return MATCH_ERROR;
if (gfc_current_ns->is_block_data)
@@ -2411,26 +2989,15 @@ match
gfc_match_omp_declare_target (void)
{
locus old_loc;
- char n[GFC_MAX_SYMBOL_LEN+1];
- gfc_symbol *sym;
match m;
- gfc_symtree *st;
+ gfc_omp_clauses *c = NULL;
+ int list;
+ gfc_omp_namelist *n;
+ gfc_symbol *s;
old_loc = gfc_current_locus;
- m = gfc_match (" (");
-
if (gfc_current_ns->proc_name
- && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
- && m == MATCH_YES)
- {
- gfc_error ("Only the !$OMP DECLARE TARGET form without "
- "list is allowed in interface block at %C");
- goto cleanup;
- }
-
- if (m == MATCH_NO
- && gfc_current_ns->proc_name
&& gfc_match_omp_eos () == MATCH_YES)
{
if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
@@ -2440,58 +3007,111 @@ gfc_match_omp_declare_target (void)
return MATCH_YES;
}
- if (m != MATCH_YES)
- return m;
+ if (gfc_current_ns->proc_name
+ && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY)
+ {
+ gfc_error ("Only the !$OMP DECLARE TARGET form without "
+ "clauses is allowed in interface block at %C");
+ goto cleanup;
+ }
- for (;;)
+ m = gfc_match (" (");
+ if (m == MATCH_YES)
{
- m = gfc_match_symbol (&sym, 0);
- switch (m)
+ c = gfc_get_omp_clauses ();
+ gfc_current_locus = old_loc;
+ m = gfc_match_omp_to_link (" (", &c->lists[OMP_LIST_TO]);
+ if (m != MATCH_YES)
+ goto syntax;
+ if (gfc_match_omp_eos () != MATCH_YES)
{
- case MATCH_YES:
- if (sym->attr.in_common)
- gfc_error_now ("OMP DECLARE TARGET on a variable at %C is an "
- "element of a COMMON block");
- else if (!gfc_add_omp_declare_target (&sym->attr, sym->name,
- &sym->declared_at))
- goto cleanup;
- goto next_item;
- case MATCH_NO:
- break;
- case MATCH_ERROR:
+ gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C");
goto cleanup;
}
+ }
+ else if (gfc_match_omp_clauses (&c, OMP_DECLARE_TARGET_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
- m = gfc_match (" / %n /", n);
- if (m == MATCH_ERROR)
- goto cleanup;
- if (m == MATCH_NO || n[0] == '\0')
- goto syntax;
+ gfc_buffer_error (false);
- st = gfc_find_symtree (gfc_current_ns->common_root, n);
- if (st == NULL)
+ for (list = OMP_LIST_TO; list != OMP_LIST_NUM;
+ list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM))
+ for (n = c->lists[list]; n; n = n->next)
+ if (n->sym)
+ n->sym->mark = 0;
+ else if (n->u.common->head)
+ n->u.common->head->mark = 0;
+
+ for (list = OMP_LIST_TO; list != OMP_LIST_NUM;
+ list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM))
+ for (n = c->lists[list]; n; n = n->next)
+ if (n->sym)
{
- gfc_error ("COMMON block /%s/ not found at %C", n);
- goto cleanup;
+ if (n->sym->attr.in_common)
+ gfc_error_now ("OMP DECLARE TARGET variable at %L is an "
+ "element of a COMMON block", &n->where);
+ else if (n->sym->attr.omp_declare_target
+ && n->sym->attr.omp_declare_target_link
+ && list != OMP_LIST_LINK)
+ gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
+ "mentioned in LINK clause and later in TO clause",
+ &n->where);
+ else if (n->sym->attr.omp_declare_target
+ && !n->sym->attr.omp_declare_target_link
+ && list == OMP_LIST_LINK)
+ gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
+ "mentioned in TO clause and later in LINK clause",
+ &n->where);
+ else if (n->sym->mark)
+ gfc_error_now ("Variable at %L mentioned multiple times in "
+ "clauses of the same OMP DECLARE TARGET directive",
+ &n->where);
+ else if (gfc_add_omp_declare_target (&n->sym->attr, n->sym->name,
+ &n->sym->declared_at))
+ {
+ if (list == OMP_LIST_LINK)
+ gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name,
+ &n->sym->declared_at);
+ }
+ n->sym->mark = 1;
+ }
+ else if (n->u.common->omp_declare_target
+ && n->u.common->omp_declare_target_link
+ && list != OMP_LIST_LINK)
+ gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
+ "mentioned in LINK clause and later in TO clause",
+ &n->where);
+ else if (n->u.common->omp_declare_target
+ && !n->u.common->omp_declare_target_link
+ && list == OMP_LIST_LINK)
+ gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
+ "mentioned in TO clause and later in LINK clause",
+ &n->where);
+ else if (n->u.common->head && n->u.common->head->mark)
+ gfc_error_now ("COMMON at %L mentioned multiple times in "
+ "clauses of the same OMP DECLARE TARGET directive",
+ &n->where);
+ else
+ {
+ n->u.common->omp_declare_target = 1;
+ n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK);
+ for (s = n->u.common->head; s; s = s->common_next)
+ {
+ s->mark = 1;
+ if (gfc_add_omp_declare_target (&s->attr, s->name,
+ &s->declared_at))
+ {
+ if (list == OMP_LIST_LINK)
+ gfc_add_omp_declare_target_link (&s->attr, s->name,
+ &s->declared_at);
+ }
+ }
}
- st->n.common->omp_declare_target = 1;
- for (sym = st->n.common->head; sym; sym = sym->common_next)
- if (!gfc_add_omp_declare_target (&sym->attr, sym->name,
- &sym->declared_at))
- goto cleanup;
- next_item:
- if (gfc_match_char (')') == MATCH_YES)
- break;
- if (gfc_match_char (',') != MATCH_YES)
- goto syntax;
- }
+ gfc_buffer_error (true);
- if (gfc_match_omp_eos () != MATCH_YES)
- {
- gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C");
- goto cleanup;
- }
+ if (c)
+ gfc_free_omp_clauses (c);
return MATCH_YES;
syntax:
@@ -2499,6 +3119,8 @@ syntax:
cleanup:
gfc_current_locus = old_loc;
+ if (c)
+ gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
@@ -2596,8 +3218,7 @@ match
gfc_match_omp_parallel_do_simd (void)
{
return match_omp (EXEC_OMP_PARALLEL_DO_SIMD,
- (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES)
- & ~OMP_CLAUSE_ORDERED);
+ OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES);
}
@@ -2633,57 +3254,70 @@ gfc_match_omp_simd (void)
match
gfc_match_omp_single (void)
{
- return match_omp (EXEC_OMP_SINGLE,
- OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE);
+ return match_omp (EXEC_OMP_SINGLE, OMP_SINGLE_CLAUSES);
}
match
-gfc_match_omp_task (void)
+gfc_match_omp_target (void)
{
- return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES);
+ return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES);
}
match
-gfc_match_omp_taskwait (void)
+gfc_match_omp_target_data (void)
{
- if (gfc_match_omp_eos () != MATCH_YES)
- {
- gfc_error ("Unexpected junk after TASKWAIT clause at %C");
- return MATCH_ERROR;
- }
- new_st.op = EXEC_OMP_TASKWAIT;
- new_st.ext.omp_clauses = NULL;
- return MATCH_YES;
+ return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES);
}
match
-gfc_match_omp_taskyield (void)
+gfc_match_omp_target_enter_data (void)
{
- if (gfc_match_omp_eos () != MATCH_YES)
- {
- gfc_error ("Unexpected junk after TASKYIELD clause at %C");
- return MATCH_ERROR;
- }
- new_st.op = EXEC_OMP_TASKYIELD;
- new_st.ext.omp_clauses = NULL;
- return MATCH_YES;
+ return match_omp (EXEC_OMP_TARGET_ENTER_DATA, OMP_TARGET_ENTER_DATA_CLAUSES);
}
match
-gfc_match_omp_target (void)
+gfc_match_omp_target_exit_data (void)
{
- return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES);
+ return match_omp (EXEC_OMP_TARGET_EXIT_DATA, OMP_TARGET_EXIT_DATA_CLAUSES);
}
match
-gfc_match_omp_target_data (void)
+gfc_match_omp_target_parallel (void)
{
- return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES);
+ return match_omp (EXEC_OMP_TARGET_PARALLEL,
+ (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES)
+ & ~(omp_mask (OMP_CLAUSE_COPYIN)));
+}
+
+
+match
+gfc_match_omp_target_parallel_do (void)
+{
+ return match_omp (EXEC_OMP_TARGET_PARALLEL_DO,
+ (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES
+ | OMP_DO_CLAUSES) & ~(omp_mask (OMP_CLAUSE_COPYIN)));
+}
+
+
+match
+gfc_match_omp_target_parallel_do_simd (void)
+{
+ return match_omp (EXEC_OMP_TARGET_PARALLEL_DO_SIMD,
+ (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES
+ | OMP_SIMD_CLAUSES) & ~(omp_mask (OMP_CLAUSE_COPYIN)));
+}
+
+
+match
+gfc_match_omp_target_simd (void)
+{
+ return match_omp (EXEC_OMP_TARGET_SIMD,
+ OMP_TARGET_CLAUSES | OMP_SIMD_CLAUSES);
}
@@ -2708,9 +3342,11 @@ match
gfc_match_omp_target_teams_distribute_parallel_do (void)
{
return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO,
- OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES
- | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
- | OMP_DO_CLAUSES);
+ (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES
+ | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
+ | OMP_DO_CLAUSES)
+ & ~(omp_mask (OMP_CLAUSE_ORDERED))
+ & ~(omp_mask (OMP_CLAUSE_LINEAR)));
}
@@ -2721,7 +3357,7 @@ gfc_match_omp_target_teams_distribute_parallel_do_simd (void)
(OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES
| OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
| OMP_DO_CLAUSES | OMP_SIMD_CLAUSES)
- & ~OMP_CLAUSE_ORDERED);
+ & ~(omp_mask (OMP_CLAUSE_ORDERED)));
}
@@ -2742,6 +3378,57 @@ gfc_match_omp_target_update (void)
match
+gfc_match_omp_task (void)
+{
+ return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES);
+}
+
+
+match
+gfc_match_omp_taskloop (void)
+{
+ return match_omp (EXEC_OMP_TASKLOOP, OMP_TASKLOOP_CLAUSES);
+}
+
+
+match
+gfc_match_omp_taskloop_simd (void)
+{
+ return match_omp (EXEC_OMP_TASKLOOP_SIMD,
+ (OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES)
+ & ~(omp_mask (OMP_CLAUSE_REDUCTION)));
+}
+
+
+match
+gfc_match_omp_taskwait (void)
+{
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after TASKWAIT clause at %C");
+ return MATCH_ERROR;
+ }
+ new_st.op = EXEC_OMP_TASKWAIT;
+ new_st.ext.omp_clauses = NULL;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_taskyield (void)
+{
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after TASKYIELD clause at %C");
+ return MATCH_ERROR;
+ }
+ new_st.op = EXEC_OMP_TASKYIELD;
+ new_st.ext.omp_clauses = NULL;
+ return MATCH_YES;
+}
+
+
+match
gfc_match_omp_teams (void)
{
return match_omp (EXEC_OMP_TEAMS, OMP_TEAMS_CLAUSES);
@@ -2760,8 +3447,10 @@ match
gfc_match_omp_teams_distribute_parallel_do (void)
{
return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO,
- OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES
- | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES);
+ (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES
+ | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES)
+ & ~(omp_mask (OMP_CLAUSE_ORDERED))
+ & ~(omp_mask (OMP_CLAUSE_LINEAR)));
}
@@ -2771,7 +3460,7 @@ gfc_match_omp_teams_distribute_parallel_do_simd (void)
return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
(OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES
| OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES
- | OMP_SIMD_CLAUSES) & ~OMP_CLAUSE_ORDERED);
+ | OMP_SIMD_CLAUSES) & ~(omp_mask (OMP_CLAUSE_ORDERED)));
}
@@ -2815,14 +3504,14 @@ gfc_match_omp_master (void)
match
gfc_match_omp_ordered (void)
{
- if (gfc_match_omp_eos () != MATCH_YES)
- {
- gfc_error ("Unexpected junk after $OMP ORDERED statement at %C");
- return MATCH_ERROR;
- }
- new_st.op = EXEC_OMP_ORDERED;
- new_st.ext.omp_clauses = NULL;
- return MATCH_YES;
+ return match_omp (EXEC_OMP_ORDERED, OMP_ORDERED_CLAUSES);
+}
+
+
+match
+gfc_match_omp_ordered_depend (void)
+{
+ return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND));
}
@@ -2935,7 +3624,7 @@ gfc_match_omp_cancel (void)
enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind ();
if (kind == OMP_CANCEL_UNKNOWN)
return MATCH_ERROR;
- if (gfc_match_omp_clauses (&c, OMP_CLAUSE_IF, false) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_IF), false) != MATCH_YES)
return MATCH_ERROR;
c->cancel = kind;
new_st.op = EXEC_OMP_CANCEL;
@@ -2992,7 +3681,8 @@ gfc_match_omp_end_single (void)
new_st.ext.omp_bool = true;
return MATCH_YES;
}
- if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_COPYPRIVATE))
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_END_SINGLE;
new_st.ext.omp_clauses = c;
@@ -3009,23 +3699,35 @@ oacc_is_loop (gfc_code *code)
}
static void
-resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
+resolve_scalar_int_expr (gfc_expr *expr, const char *clause)
{
if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ || expr->ts.type != BT_INTEGER
+ || expr->rank != 0)
gfc_error ("%s clause at %L requires a scalar INTEGER expression",
- clause, &expr->where);
+ clause, &expr->where);
}
-
static void
-resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
+resolve_positive_int_expr (gfc_expr *expr, const char *clause)
{
- resolve_oacc_scalar_int_expr (expr, clause);
- if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
- && mpz_sgn(expr->value.integer) <= 0)
+ resolve_scalar_int_expr (expr, clause);
+ if (expr->expr_type == EXPR_CONSTANT
+ && expr->ts.type == BT_INTEGER
+ && mpz_sgn (expr->value.integer) <= 0)
gfc_warning (0, "INTEGER expression of %s clause at %L must be positive",
- clause, &expr->where);
+ clause, &expr->where);
+}
+
+static void
+resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause)
+{
+ resolve_scalar_int_expr (expr, clause);
+ if (expr->expr_type == EXPR_CONSTANT
+ && expr->ts.type == BT_INTEGER
+ && mpz_sgn (expr->value.integer) < 0)
+ gfc_warning (0, "INTEGER expression of %s clause at %L must be "
+ "non-negative", clause, &expr->where);
}
/* Emits error when symbol is pointer, cray pointer or cray pointee
@@ -3229,15 +3931,22 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_omp_namelist *n;
gfc_expr_list *el;
int list;
+ int ifc;
+ bool if_without_mod = false;
+ gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
"TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
- "CACHE" };
+ "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR" };
if (omp_clauses == NULL)
return;
+ if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse)
+ gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L",
+ &code->loc);
+
if (omp_clauses->if_expr)
{
gfc_expr *expr = omp_clauses->if_expr;
@@ -3245,7 +3954,101 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
|| expr->ts.type != BT_LOGICAL || expr->rank != 0)
gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
&expr->where);
+ if_without_mod = true;
}
+ for (ifc = 0; ifc < OMP_IF_LAST; ifc++)
+ if (omp_clauses->if_exprs[ifc])
+ {
+ gfc_expr *expr = omp_clauses->if_exprs[ifc];
+ bool ok = true;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_LOGICAL || expr->rank != 0)
+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+ &expr->where);
+ else if (if_without_mod)
+ {
+ gfc_error ("IF clause without modifier at %L used together with"
+ "IF clauses with modifiers",
+ &omp_clauses->if_expr->where);
+ if_without_mod = false;
+ }
+ else
+ switch (code->op)
+ {
+ case EXEC_OMP_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ ok = ifc == OMP_IF_PARALLEL;
+ break;
+
+ case EXEC_OMP_TASK:
+ ok = ifc == OMP_IF_TASK;
+ break;
+
+ case EXEC_OMP_TASKLOOP:
+ case EXEC_OMP_TASKLOOP_SIMD:
+ ok = ifc == OMP_IF_TASKLOOP;
+ break;
+
+ case EXEC_OMP_TARGET:
+ case EXEC_OMP_TARGET_TEAMS:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TARGET_SIMD:
+ ok = ifc == OMP_IF_TARGET;
+ break;
+
+ case EXEC_OMP_TARGET_DATA:
+ ok = ifc == OMP_IF_TARGET_DATA;
+ break;
+
+ case EXEC_OMP_TARGET_UPDATE:
+ ok = ifc == OMP_IF_TARGET_UPDATE;
+ break;
+
+ case EXEC_OMP_TARGET_ENTER_DATA:
+ ok = ifc == OMP_IF_TARGET_ENTER_DATA;
+ break;
+
+ case EXEC_OMP_TARGET_EXIT_DATA:
+ ok = ifc == OMP_IF_TARGET_EXIT_DATA;
+ break;
+
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_PARALLEL:
+ case EXEC_OMP_TARGET_PARALLEL_DO:
+ case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+ ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_PARALLEL;
+ break;
+
+ default:
+ ok = false;
+ break;
+ }
+ if (!ok)
+ {
+ static const char *ifs[] = {
+ "PARALLEL",
+ "TASK",
+ "TASKLOOP",
+ "TARGET",
+ "TARGET DATA",
+ "TARGET UPDATE",
+ "TARGET ENTER DATA",
+ "TARGET EXIT DATA"
+ };
+ gfc_error ("IF clause modifier %s at %L not appropriate for "
+ "the current OpenMP construct", ifs[ifc], &expr->where);
+ }
+ }
+
if (omp_clauses->final_expr)
{
gfc_expr *expr = omp_clauses->final_expr;
@@ -3255,13 +4058,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&expr->where);
}
if (omp_clauses->num_threads)
- {
- gfc_expr *expr = omp_clauses->num_threads;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER || expr->rank != 0)
- gfc_error ("NUM_THREADS clause at %L requires a scalar "
- "INTEGER expression", &expr->where);
- }
+ resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS");
if (omp_clauses->chunk_size)
{
gfc_expr *expr = omp_clauses->chunk_size;
@@ -3499,6 +4296,36 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
+ if (list == OMP_LIST_DEPEND)
+ {
+ if (n->u.depend_op == OMP_DEPEND_SINK_FIRST
+ || n->u.depend_op == OMP_DEPEND_SINK)
+ {
+ if (code->op != EXEC_OMP_ORDERED)
+ gfc_error ("SINK dependence type only allowed "
+ "on ORDERED directive at %L", &n->where);
+ else if (omp_clauses->depend_source)
+ {
+ gfc_error ("DEPEND SINK used together with "
+ "DEPEND SOURCE on the same construct "
+ "at %L", &n->where);
+ omp_clauses->depend_source = false;
+ }
+ else if (n->expr)
+ {
+ if (!gfc_resolve_expr (n->expr)
+ || n->expr->ts.type != BT_INTEGER
+ || n->expr->rank != 0)
+ gfc_error ("SINK addend not a constant integer"
+ "at %L", &n->where);
+ }
+ continue;
+ }
+ else if (code->op == EXEC_OMP_ORDERED)
+ gfc_error ("Only SOURCE or SINK dependence types "
+ "are allowed on ORDERED directive at %L",
+ &n->where);
+ }
if (n->expr)
{
if (!gfc_resolve_expr (n->expr)
@@ -3555,6 +4382,62 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
else
resolve_oacc_data_clauses (n->sym, n->where, name);
}
+ if (list == OMP_LIST_MAP && !openacc)
+ switch (code->op)
+ {
+ case EXEC_OMP_TARGET:
+ case EXEC_OMP_TARGET_DATA:
+ switch (n->u.map_op)
+ {
+ case OMP_MAP_TO:
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_FROM:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_TOFROM:
+ case OMP_MAP_ALWAYS_TOFROM:
+ case OMP_MAP_ALLOC:
+ break;
+ default:
+ gfc_error ("TARGET%s with map-type other than TO, "
+ "FROM, TOFROM, or ALLOC on MAP clause "
+ "at %L",
+ code->op == EXEC_OMP_TARGET
+ ? "" : " DATA", &n->where);
+ break;
+ }
+ break;
+ case EXEC_OMP_TARGET_ENTER_DATA:
+ switch (n->u.map_op)
+ {
+ case OMP_MAP_TO:
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_ALLOC:
+ break;
+ default:
+ gfc_error ("TARGET ENTER DATA with map-type other "
+ "than TO, or ALLOC on MAP clause at %L",
+ &n->where);
+ break;
+ }
+ break;
+ case EXEC_OMP_TARGET_EXIT_DATA:
+ switch (n->u.map_op)
+ {
+ case OMP_MAP_FROM:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_RELEASE:
+ case OMP_MAP_DELETE:
+ break;
+ default:
+ gfc_error ("TARGET EXIT DATA with map-type other "
+ "than FROM, RELEASE, or DELETE on MAP "
+ "clause at %L", &n->where);
+ break;
+ }
+ break;
+ default:
+ break;
+ }
}
if (list != OMP_LIST_DEPEND)
@@ -3569,6 +4452,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->name, name, &n->where);
}
break;
+ case OMP_LIST_IS_DEVICE_PTR:
+ case OMP_LIST_USE_DEVICE_PTR:
+ /* FIXME: Handle these. */
+ break;
default:
for (; n != NULL; n = n->next)
{
@@ -3726,12 +4613,30 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
break;
case OMP_LIST_LINEAR:
- if (n->sym->ts.type != BT_INTEGER)
+ if (code
+ && n->u.linear_op != OMP_LINEAR_DEFAULT
+ && n->u.linear_op != linear_op)
+ {
+ gfc_error ("LINEAR clause modifier used on DO or SIMD"
+ " construct at %L", &n->where);
+ linear_op = n->u.linear_op;
+ }
+ else if (omp_clauses->orderedc)
+ gfc_error ("LINEAR clause specified together with"
+ "ORDERED clause with argument at %L",
+ &n->where);
+ else if (n->u.linear_op != OMP_LINEAR_REF
+ && n->sym->ts.type != BT_INTEGER)
gfc_error ("LINEAR variable %qs must be INTEGER "
"at %L", n->sym->name, &n->where);
- else if (!code && !n->sym->attr.value)
- gfc_error ("LINEAR dummy argument %qs must have VALUE "
- "attribute at %L", n->sym->name, &n->where);
+ else if ((n->u.linear_op == OMP_LINEAR_REF
+ || n->u.linear_op == OMP_LINEAR_UVAL)
+ && n->sym->attr.value)
+ gfc_error ("LINEAR dummy argument %qs with VALUE "
+ "attribute with %s modifier at %L",
+ n->sym->name,
+ n->u.linear_op == OMP_LINEAR_REF
+ ? "REF" : "UVAL", &n->where);
else if (n->expr)
{
gfc_expr *expr = n->expr;
@@ -3742,9 +4647,25 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"a scalar integer linear-step expression",
n->sym->name, &n->where);
else if (!code && expr->expr_type != EXPR_CONSTANT)
- gfc_error ("%qs in LINEAR clause at %L requires "
- "a constant integer linear-step expression",
- n->sym->name, &n->where);
+ {
+ if (expr->expr_type == EXPR_VARIABLE
+ && expr->symtree->n.sym->attr.dummy
+ && expr->symtree->n.sym->ns == ns)
+ {
+ gfc_omp_namelist *n2;
+ for (n2 = omp_clauses->lists[OMP_LIST_UNIFORM];
+ n2; n2 = n2->next)
+ if (n2->sym == expr->symtree->n.sym)
+ break;
+ if (n2)
+ break;
+ }
+ gfc_error ("%qs in LINEAR clause at %L requires "
+ "a constant integer linear-step "
+ "expression or dummy argument "
+ "specified in UNIFORM clause",
+ n->sym->name, &n->where);
+ }
}
break;
/* Workaround for PR middle-end/26316, nothing really needs
@@ -3789,37 +4710,17 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
if (omp_clauses->safelen_expr)
- {
- gfc_expr *expr = omp_clauses->safelen_expr;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER || expr->rank != 0)
- gfc_error ("SAFELEN clause at %L requires a scalar "
- "INTEGER expression", &expr->where);
- }
+ resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN");
if (omp_clauses->simdlen_expr)
- {
- gfc_expr *expr = omp_clauses->simdlen_expr;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER || expr->rank != 0)
- gfc_error ("SIMDLEN clause at %L requires a scalar "
- "INTEGER expression", &expr->where);
- }
+ resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN");
if (omp_clauses->num_teams)
- {
- gfc_expr *expr = omp_clauses->num_teams;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER || expr->rank != 0)
- gfc_error ("NUM_TEAMS clause at %L requires a scalar "
- "INTEGER expression", &expr->where);
- }
+ resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS");
if (omp_clauses->device)
- {
- gfc_expr *expr = omp_clauses->device;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER || expr->rank != 0)
- gfc_error ("DEVICE clause at %L requires a scalar "
- "INTEGER expression", &expr->where);
- }
+ resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE");
+ if (omp_clauses->hint)
+ resolve_scalar_int_expr (omp_clauses->hint, "HINT");
+ if (omp_clauses->priority)
+ resolve_nonnegative_int_expr (omp_clauses->priority, "PRIORITY");
if (omp_clauses->dist_chunk_size)
{
gfc_expr *expr = omp_clauses->dist_chunk_size;
@@ -3829,36 +4730,50 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"a scalar INTEGER expression", &expr->where);
}
if (omp_clauses->thread_limit)
- {
- gfc_expr *expr = omp_clauses->thread_limit;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER || expr->rank != 0)
- gfc_error ("THREAD_LIMIT clause at %L requires a scalar "
- "INTEGER expression", &expr->where);
- }
+ resolve_positive_int_expr (omp_clauses->thread_limit, "THREAD_LIMIT");
+ if (omp_clauses->grainsize)
+ resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE");
+ if (omp_clauses->num_tasks)
+ resolve_positive_int_expr (omp_clauses->num_tasks, "NUM_TASKS");
if (omp_clauses->async)
if (omp_clauses->async_expr)
- resolve_oacc_scalar_int_expr (omp_clauses->async_expr, "ASYNC");
+ resolve_scalar_int_expr (omp_clauses->async_expr, "ASYNC");
if (omp_clauses->num_gangs_expr)
- resolve_oacc_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS");
+ resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS");
if (omp_clauses->num_workers_expr)
- resolve_oacc_positive_int_expr (omp_clauses->num_workers_expr,
- "NUM_WORKERS");
+ resolve_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS");
if (omp_clauses->vector_length_expr)
- resolve_oacc_positive_int_expr (omp_clauses->vector_length_expr,
- "VECTOR_LENGTH");
+ resolve_positive_int_expr (omp_clauses->vector_length_expr,
+ "VECTOR_LENGTH");
if (omp_clauses->gang_num_expr)
- resolve_oacc_positive_int_expr (omp_clauses->gang_num_expr, "GANG");
+ resolve_positive_int_expr (omp_clauses->gang_num_expr, "GANG");
if (omp_clauses->gang_static_expr)
- resolve_oacc_positive_int_expr (omp_clauses->gang_static_expr, "GANG");
+ resolve_positive_int_expr (omp_clauses->gang_static_expr, "GANG");
if (omp_clauses->worker_expr)
- resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER");
+ resolve_positive_int_expr (omp_clauses->worker_expr, "WORKER");
if (omp_clauses->vector_expr)
- resolve_oacc_positive_int_expr (omp_clauses->vector_expr, "VECTOR");
+ resolve_positive_int_expr (omp_clauses->vector_expr, "VECTOR");
if (omp_clauses->wait)
if (omp_clauses->wait_list)
for (el = omp_clauses->wait_list; el; el = el->next)
- resolve_oacc_scalar_int_expr (el->expr, "WAIT");
+ resolve_scalar_int_expr (el->expr, "WAIT");
+ if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED)
+ gfc_error ("SOURCE dependence type only allowed "
+ "on ORDERED directive at %L", &code->loc);
+ if (!openacc && code && omp_clauses->lists[OMP_LIST_MAP] == NULL)
+ {
+ const char *p = NULL;
+ switch (code->op)
+ {
+ case EXEC_OMP_TARGET_DATA: p = "TARGET DATA"; break;
+ case EXEC_OMP_TARGET_ENTER_DATA: p = "TARGET ENTER DATA"; break;
+ case EXEC_OMP_TARGET_EXIT_DATA: p = "TARGET EXIT DATA"; break;
+ default: break;
+ }
+ if (p)
+ gfc_error ("%s must contain at least one MAP clause at %L",
+ p, &code->loc);
+ }
}
@@ -4361,7 +5276,10 @@ gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
gfc_code *c;
omp_current_do_code = code->block->next;
- omp_current_do_collapse = code->ext.omp_clauses->collapse;
+ if (code->ext.omp_clauses->orderedc)
+ omp_current_do_collapse = code->ext.omp_clauses->orderedc;
+ else
+ omp_current_do_collapse = code->ext.omp_clauses->collapse;
for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++)
{
c = c->block;
@@ -4415,6 +5333,8 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
{
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_PARALLEL_DO:
+ case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
@@ -4540,8 +5460,17 @@ resolve_omp_do (gfc_code *code)
is_simd = true;
break;
case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break;
+ case EXEC_OMP_TARGET_PARALLEL_DO: name = "!$OMP TARGET PARALLEL DO"; break;
+ case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+ name = "!$OMP TARGET PARALLEL DO SIMD";
+ is_simd = true;
+ break;
+ case EXEC_OMP_TARGET_SIMD:
+ name = "!$OMP TARGET SIMD";
+ is_simd = true;
+ break;
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- name = "!$OMP TARGET TEAMS_DISTRIBUTE";
+ name = "!$OMP TARGET TEAMS DISTRIBUTE";
break;
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
name = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO";
@@ -4554,7 +5483,12 @@ resolve_omp_do (gfc_code *code)
name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD";
is_simd = true;
break;
- case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS_DISTRIBUTE"; break;
+ case EXEC_OMP_TASKLOOP: name = "!$OMP TASKLOOP"; break;
+ case EXEC_OMP_TASKLOOP_SIMD:
+ name = "!$OMP TASKLOOP SIMD";
+ is_simd = true;
+ break;
+ case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS DISTRIBUTE"; break;
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
name = "!$OMP TEAMS DISTRIBUTE PARALLEL DO";
break;
@@ -4573,9 +5507,14 @@ resolve_omp_do (gfc_code *code)
resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
do_code = code->block->next;
- collapse = code->ext.omp_clauses->collapse;
- if (collapse <= 0)
- collapse = 1;
+ if (code->ext.omp_clauses->orderedc)
+ collapse = code->ext.omp_clauses->orderedc;
+ else
+ {
+ collapse = code->ext.omp_clauses->collapse;
+ if (collapse <= 0)
+ collapse = 1;
+ }
for (i = 1; i <= collapse; i++)
{
if (do_code->op == EXEC_DO_WHILE)
@@ -4972,7 +5911,7 @@ resolve_oacc_loop_blocks (gfc_code *code)
}
else
{
- resolve_oacc_positive_int_expr (el->expr, "TILE");
+ resolve_positive_int_expr (el->expr, "TILE");
if (el->expr->expr_type != EXPR_CONSTANT)
gfc_error ("TILE requires constant expression at %L",
&code->loc);
@@ -5134,10 +6073,15 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_SIMD:
+ case EXEC_OMP_TARGET_PARALLEL_DO:
+ case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_SIMD:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TASKLOOP:
+ case EXEC_OMP_TASKLOOP_SIMD:
case EXEC_OMP_TEAMS_DISTRIBUTE:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
@@ -5152,6 +6096,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OMP_SINGLE:
case EXEC_OMP_TARGET:
case EXEC_OMP_TARGET_DATA:
+ case EXEC_OMP_TARGET_ENTER_DATA:
+ case EXEC_OMP_TARGET_EXIT_DATA:
+ case EXEC_OMP_TARGET_PARALLEL:
case EXEC_OMP_TARGET_TEAMS:
case EXEC_OMP_TASK:
case EXEC_OMP_TEAMS:
@@ -5185,7 +6132,8 @@ gfc_resolve_omp_declare_simd (gfc_namespace *ns)
for (ods = ns->omp_declare_simd; ods; ods = ods->next)
{
- if (ods->proc_name != ns->proc_name)
+ if (ods->proc_name != NULL
+ && ods->proc_name != ns->proc_name)
gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure "
"%qs at %L", ns->proc_name->name, &ods->where);
if (ods->clauses)