aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/openmp.c
diff options
context:
space:
mode:
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)
generated by cgit v1.1 at 2025-04-29 10:22:03 +0000