public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-12] Fortran/openmp: Partial OpenMP 5.2 doacross and omp_cur_iteration support
@ 2022-09-05 16:25 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2022-09-05 16:25 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:bc81271a9f7b03ba3c92672bd3df82974a4c7b60
commit bc81271a9f7b03ba3c92672bd3df82974a4c7b60
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Mon Sep 5 18:18:57 2022 +0200
Fortran/openmp: Partial OpenMP 5.2 doacross and omp_cur_iteration support
Add the Fortran support to the ME/C/C++ commit
r13-2388-ga651e6d59188da8992f8bfae2df1cb4e6316f9e6
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_omp_namelist, show_omp_clauses): Handle
omp_cur_iteration and distinguish doacross/depend.
* gfortran.h (enum gfc_omp_depend_doacross_op): Renamed from
gfc_omp_depend_op.
(enum gfc_omp_depend_doacross_op): Add OMP_DOACROSS_SINK_FIRST,
Rename OMP_DEPEND_SINK to OMP_DOACROSS_SINK.
(gfc_omp_namelist) Handle renaming, rename depend_op to
depend_doacross_op.
(struct gfc_omp_clauses): Add doacross_source.
* openmp.cc (gfc_match_omp_depend_sink): Renamed to ...
(gfc_match_omp_doacross_sink): ... this; handle omp_all_memory.
(enum omp_mask2): Add OMP_CLAUSE_DOACROSS.
(gfc_match_omp_clauses): Handle 'doacross' and syntax changes to
depend.
(gfc_match_omp_depobj): Simplify as sink/source are now impossible.
(gfc_match_omp_ordered_depend): Request OMP_CLAUSE_DOACROSS.
(resolve_omp_clauses): Update sink/source checks.
(gfc_resolve_omp_directive): Resolve EXEC_OMP_ORDERED clauses.
* parse.cc (decode_omp_directive): Handle 'ordered doacross'.
* trans-openmp.cc (gfc_trans_omp_clauses): Handle doacross.
(gfc_trans_omp_do): Fix OMP_FOR_ORIG_DECLS handling if 'ordered'
clause is present.
(gfc_trans_omp_depobj): Update for member name change.
libgomp/ChangeLog:
* libgomp.texi (OpenMP 5.2): Update doacross/omp_cur_iteration status.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/all-memory-1.f90: Update dg-error.
* gfortran.dg/gomp/depend-iterator-2.f90: Likewise.
* gfortran.dg/gomp/depobj-2.f90: Likewise.
* gfortran.dg/gomp/doacross-5.f90: New test.
* gfortran.dg/gomp/doacross-6.f90: New test.
(cherry picked from commit 938cda536019cd6a1bc0dd2346381185b420bbf8)
Diff:
---
gcc/fortran/ChangeLog.omp | 29 +++
gcc/fortran/dump-parse-tree.cc | 38 +++-
gcc/fortran/gfortran.h | 13 +-
gcc/fortran/openmp.cc | 218 +++++++++++++--------
gcc/fortran/parse.cc | 3 +-
gcc/fortran/trans-openmp.cc | 35 ++--
gcc/testsuite/ChangeLog.omp | 11 ++
gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 | 2 +-
.../gfortran.dg/gomp/depend-iterator-2.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 | 6 +-
gcc/testsuite/gfortran.dg/gomp/doacross-5.f90 | 88 +++++++++
gcc/testsuite/gfortran.dg/gomp/doacross-6.f90 | 77 ++++++++
libgomp/ChangeLog.omp | 7 +
libgomp/libgomp.texi | 5 +-
14 files changed, 417 insertions(+), 117 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 84aefdad573..6ca5ae8eac5 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,32 @@
+2022-09-05 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline:
+ 2022-09-05 Tobias Burnus <tobias@codesourcery.com>
+
+ * dump-parse-tree.cc (show_omp_namelist, show_omp_clauses): Handle
+ omp_cur_iteration and distinguish doacross/depend.
+ * gfortran.h (enum gfc_omp_depend_doacross_op): Renamed from
+ gfc_omp_depend_op.
+ (enum gfc_omp_depend_doacross_op): Add OMP_DOACROSS_SINK_FIRST,
+ Rename OMP_DEPEND_SINK to OMP_DOACROSS_SINK.
+ (gfc_omp_namelist) Handle renaming, rename depend_op to
+ depend_doacross_op.
+ (struct gfc_omp_clauses): Add doacross_source.
+ * openmp.cc (gfc_match_omp_depend_sink): Renamed to ...
+ (gfc_match_omp_doacross_sink): ... this; handle omp_all_memory.
+ (enum omp_mask2): Add OMP_CLAUSE_DOACROSS.
+ (gfc_match_omp_clauses): Handle 'doacross' and syntax changes to
+ depend.
+ (gfc_match_omp_depobj): Simplify as sink/source are now impossible.
+ (gfc_match_omp_ordered_depend): Request OMP_CLAUSE_DOACROSS.
+ (resolve_omp_clauses): Update sink/source checks.
+ (gfc_resolve_omp_directive): Resolve EXEC_OMP_ORDERED clauses.
+ * parse.cc (decode_omp_directive): Handle 'ordered doacross'.
+ * trans-openmp.cc (gfc_trans_omp_clauses): Handle doacross.
+ (gfc_trans_omp_do): Fix OMP_FOR_ORIG_DECLS handling if 'ordered'
+ clause is present.
+ (gfc_trans_omp_depobj): Update for member name change.
+
2022-09-05 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline:
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 7e93d30898a..04ee9c1dacc 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1337,8 +1337,15 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
if (n->u2.ns != ns_iter)
{
if (n != n2)
- fputs (list_type == OMP_LIST_AFFINITY
- ? ") AFFINITY(" : ") DEPEND(", dumpfile);
+ {
+ fputs (") ", dumpfile);
+ if (list_type == OMP_LIST_AFFINITY)
+ fputs ("AFFINITY (", dumpfile);
+ else if (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST)
+ fputs ("DOACROSS (", dumpfile);
+ else
+ fputs ("DEPEND (", dumpfile);
+ }
if (n->u2.ns)
{
fputs ("ITERATOR(", dumpfile);
@@ -1374,7 +1381,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
default: break;
}
else if (list_type == OMP_LIST_DEPEND)
- switch (n->u.depend_op)
+ switch (n->u.depend_doacross_op)
{
case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
@@ -1385,10 +1392,14 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
fputs ("mutexinoutset:", dumpfile);
break;
case OMP_DEPEND_SINK_FIRST:
+ case OMP_DOACROSS_SINK_FIRST:
fputs ("sink:", dumpfile);
while (1)
{
- fprintf (dumpfile, "%s", n->sym->name);
+ if (!n->sym)
+ fputs ("omp_cur_iteration", dumpfile);
+ else
+ fprintf (dumpfile, "%s", n->sym->name);
if (n->expr)
{
fputc ('+', dumpfile);
@@ -1396,9 +1407,13 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
}
if (n->next == NULL)
break;
- else if (n->next->u.depend_op != OMP_DEPEND_SINK)
+ else if (n->next->u.depend_doacross_op != OMP_DOACROSS_SINK)
{
- fputs (") DEPEND(", dumpfile);
+ if (n->next->u.depend_doacross_op
+ == OMP_DOACROSS_SINK_FIRST)
+ fputs (") DOACROSS(", dumpfile);
+ else
+ fputs (") DEPEND(", dumpfile);
break;
}
fputc (',', dumpfile);
@@ -1688,7 +1703,14 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_AFFINITY: type = "AFFINITY"; break;
case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
case OMP_LIST_LINEAR: type = "LINEAR"; break;
- case OMP_LIST_DEPEND: type = "DEPEND"; break;
+ case OMP_LIST_DEPEND:
+ if (omp_clauses->lists[list_type]
+ && (omp_clauses->lists[list_type]->u.depend_doacross_op
+ == OMP_DOACROSS_SINK_FIRST))
+ type = "DOACROSS";
+ else
+ type = "DEPEND";
+ break;
case OMP_LIST_MAP: type = "MAP"; break;
case OMP_LIST_TO: type = "TO"; break;
case OMP_LIST_FROM: type = "FROM"; break;
@@ -1909,6 +1931,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
fputs (" DESTROY", dumpfile);
if (omp_clauses->depend_source)
fputs (" DEPEND(source)", dumpfile);
+ if (omp_clauses->doacross_source)
+ fputs (" DOACROSS(source:)", dumpfile);
if (omp_clauses->capture)
fputs (" CAPTURE", dumpfile);
if (omp_clauses->depobj_update != OMP_DEPEND_UNSET)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a9892b4269a..849c6226653 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1266,7 +1266,7 @@ enum gfc_omp_reduction_op
OMP_REDUCTION_USER
};
-enum gfc_omp_depend_op
+enum gfc_omp_depend_doacross_op
{
OMP_DEPEND_UNSET,
OMP_DEPEND_IN,
@@ -1276,7 +1276,8 @@ enum gfc_omp_depend_op
OMP_DEPEND_MUTEXINOUTSET,
OMP_DEPEND_DEPOBJ,
OMP_DEPEND_SINK_FIRST,
- OMP_DEPEND_SINK
+ OMP_DOACROSS_SINK_FIRST,
+ OMP_DOACROSS_SINK
};
enum gfc_omp_map_op
@@ -1346,7 +1347,7 @@ typedef struct gfc_omp_namelist
union
{
gfc_omp_reduction_op reduction_op;
- gfc_omp_depend_op depend_op;
+ gfc_omp_depend_doacross_op depend_doacross_op;
gfc_omp_map_op map_op;
struct
{
@@ -1543,17 +1544,17 @@ typedef struct gfc_omp_clauses
unsigned nowait:1, ordered:1, untied:1, mergeable:1, ancestor:1;
unsigned inbranch:1, notinbranch:1, nogroup:1;
unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
- unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
+ unsigned simd:1, threads:1, doacross_source:1, depend_source:1, destroy:1;
unsigned order_unconstrained:1, order_reproducible:1, capture:1;
unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
- unsigned non_rectangular:1;
+ unsigned non_rectangular:1, order_concurrent:1;
ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
ENUM_BITFIELD (gfc_omp_memorder) memorder:3;
ENUM_BITFIELD (gfc_omp_memorder) fail:3;
ENUM_BITFIELD (gfc_omp_cancel_kind) cancel:3;
ENUM_BITFIELD (gfc_omp_proc_bind_kind) proc_bind:3;
- ENUM_BITFIELD (gfc_omp_depend_op) depobj_update:4;
+ ENUM_BITFIELD (gfc_omp_depend_doacross_op) depobj_update:4;
ENUM_BITFIELD (gfc_omp_bind_type) bind:2;
ENUM_BITFIELD (gfc_omp_at_type) at:2;
ENUM_BITFIELD (gfc_omp_severity_type) severity:2;
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 5b30238a8bb..de4a3c3a6e2 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -598,11 +598,13 @@ syntax_error:
}
-/* Match depend(sink : ...) construct a namelist from it. */
+/* Match doacross(sink : ...) construct a namelist from it;
+ if depend is true, match legacy 'depend(sink : ...)'. */
static match
-gfc_match_omp_depend_sink (gfc_omp_namelist **list)
+gfc_match_omp_doacross_sink (gfc_omp_namelist **list, bool depend)
{
+ char n[GFC_MAX_SYMBOL_LEN+1];
gfc_omp_namelist *head, *tail, *p;
locus old_loc, cur_loc;
gfc_symbol *sym;
@@ -614,49 +616,51 @@ gfc_match_omp_depend_sink (gfc_omp_namelist **list)
for (;;)
{
cur_loc = gfc_current_locus;
- switch (gfc_match_symbol (&sym, 1))
+
+ if (gfc_match_name (n) != MATCH_YES)
+ goto syntax;
+ if (__builtin_expect ((strcmp (n, "omp_all_memory") == 0), 0))
{
- 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 (__builtin_expect (strcmp (sym->name, "omp_all_memory") == 0, 0))
- {
- gfc_error ("%<omp_all_memory%> used with DEPEND kind "
- "other than OUT or INOUT at %C");
- goto cleanup;
- }
- 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:
+ gfc_error ("%<omp_all_memory%> used with dependence-type "
+ "other than OUT or INOUT at %C");
goto cleanup;
}
-
+ sym = NULL;
+ if (!(strcmp (n, "omp_cur_iteration") == 0))
+ {
+ gfc_symtree *st;
+ if (gfc_get_ha_sym_tree (n, &st))
+ goto syntax;
+ sym = st->n.sym;
+ gfc_set_sym_referenced (sym);
+ }
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ {
+ head = tail = p;
+ head->u.depend_doacross_op = (depend ? OMP_DEPEND_SINK_FIRST
+ : OMP_DOACROSS_SINK_FIRST);
+ }
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ tail->u.depend_doacross_op = OMP_DOACROSS_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);
+ }
if (gfc_match_char (')') == MATCH_YES)
break;
if (gfc_match_char (',') != MATCH_YES)
@@ -670,7 +674,7 @@ gfc_match_omp_depend_sink (gfc_omp_namelist **list)
return MATCH_YES;
syntax:
- gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
+ gfc_error ("Syntax error in OpenMP SINK dependence-type list at %C");
cleanup:
gfc_free_omp_namelist (head, false);
@@ -1012,6 +1016,7 @@ enum omp_mask2
OMP_CLAUSE_HAS_DEVICE_ADDR, /* OpenMP 5.1 */
OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
OMP_CLAUSE_USES_ALLOCATORS,
+ OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
/* This must come last. */
OMP_MASK2_LAST
};
@@ -2449,18 +2454,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
OMP_MAP_RELEASE, true,
allow_derived))
continue;
- if ((mask & OMP_CLAUSE_DEPEND)
- && gfc_match ("depend ( ") == MATCH_YES)
+ /* DOACROSS: match 'doacross' and 'depend' with sink/source.
+ DEPEND: match 'depend' but not sink/source. */
+ m = MATCH_NO;
+ if (((mask & OMP_CLAUSE_DOACROSS)
+ && gfc_match ("doacross ( ") == MATCH_YES)
+ || (((mask & OMP_CLAUSE_DEPEND) || (mask & OMP_CLAUSE_DOACROSS))
+ && (m = gfc_match ("depend ( ")) == MATCH_YES))
{
bool has_omp_all_memory;
+ bool is_depend = m == MATCH_YES;
gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
- match m_it = gfc_match_iterator (&ns_iter, false);
+ match m_it = MATCH_NO;
+ if (is_depend)
+ m_it = gfc_match_iterator (&ns_iter, false);
if (m_it == MATCH_ERROR)
break;
if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES)
break;
m = MATCH_YES;
- gfc_omp_depend_op depend_op = OMP_DEPEND_OUT;
+ gfc_omp_depend_doacross_op depend_op = OMP_DEPEND_OUT;
if (gfc_match ("inoutset") == MATCH_YES)
depend_op = OMP_DEPEND_INOUTSET;
else if (gfc_match ("inout") == MATCH_YES)
@@ -2473,34 +2486,77 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
depend_op = OMP_DEPEND_MUTEXINOUTSET;
else if (gfc_match ("depobj") == MATCH_YES)
depend_op = OMP_DEPEND_DEPOBJ;
- else if (!c->depend_source
- && gfc_match ("source )") == MATCH_YES)
+ else if (gfc_match ("source") == MATCH_YES)
{
if (m_it == MATCH_YES)
{
gfc_error ("ITERATOR may not be combined with SOURCE "
"at %C");
- gfc_free_omp_clauses (c);
- return MATCH_ERROR;
+ goto error;
+ }
+ if (!(mask & OMP_CLAUSE_DOACROSS))
+ {
+ gfc_error ("SOURCE at %C not permitted as dependence-type"
+ " for this directive");
+ goto error;
+ }
+ if (c->doacross_source)
+ {
+ gfc_error ("Duplicated clause with SOURCE dependence-type"
+ " at %C");
+ goto error;
+ }
+ gfc_gobble_whitespace ();
+ m = gfc_match (": ");
+ if (m != MATCH_YES && !is_depend)
+ {
+ gfc_error ("Expected %<:%> at %C");
+ goto error;
}
- c->depend_source = true;
+ if (gfc_match (")") != MATCH_YES
+ && !(m == MATCH_YES
+ && gfc_match ("omp_cur_iteration )") == MATCH_YES))
+ {
+ gfc_error ("Expected %<)%> or %<omp_cur_iteration)%> "
+ "at %C");
+ goto error;
+ }
+ c->doacross_source = true;
+ c->depend_source = is_depend;
continue;
}
- else if (gfc_match ("sink : ") == MATCH_YES)
+ else if (gfc_match ("sink ") == MATCH_YES)
{
+ if (!(mask & OMP_CLAUSE_DOACROSS))
+ {
+ gfc_error ("SINK at %C not permitted as dependence-type "
+ "for this directive");
+ goto error;
+ }
+ if (gfc_match (": ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<:%> at %C");
+ goto error;
+ }
if (m_it == MATCH_YES)
{
gfc_error ("ITERATOR may not be combined with SINK "
"at %C");
- break;
+ goto error;
}
- if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND])
- == MATCH_YES)
+ m = gfc_match_omp_doacross_sink (&c->lists[OMP_LIST_DEPEND],
+ is_depend);
+ if (m == MATCH_YES)
continue;
- m = MATCH_NO;
+ goto error;
}
else
m = MATCH_NO;
+ if (!(mask & OMP_CLAUSE_DEPEND))
+ {
+ gfc_error ("Expected dependence-type SINK or SOURCE at %C");
+ goto error;
+ }
head = NULL;
if (ns_iter)
gfc_current_ns = ns_iter;
@@ -2522,7 +2578,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
{
- n->u.depend_op = depend_op;
+ n->u.depend_doacross_op = depend_op;
n->u2.ns = ns_iter;
if (ns_iter)
ns_iter->refs++;
@@ -4519,18 +4575,15 @@ gfc_match_omp_depobj (void)
if (c->depobj_update == OMP_DEPEND_UNSET && !c->destroy)
{
- if (!c->depend_source && !c->lists[OMP_LIST_DEPEND])
+ if (!c->doacross_source && !c->lists[OMP_LIST_DEPEND])
{
gfc_error ("Expected DEPEND, UPDATE, or DESTROY clause at %C");
goto error;
}
- if (c->depend_source
- || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK_FIRST
- || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK
- || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_DEPOBJ)
+ if (c->lists[OMP_LIST_DEPEND]->u.depend_doacross_op == OMP_DEPEND_DEPOBJ)
{
gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall not "
- "have dependence-type SOURCE, SINK or DEPOBJ",
+ "have dependence-type DEPOBJ",
c->lists[OMP_LIST_DEPEND]
? &c->lists[OMP_LIST_DEPEND]->where : &gfc_current_locus);
goto error;
@@ -6718,7 +6771,7 @@ gfc_match_omp_nothing (void)
match
gfc_match_omp_ordered_depend (void)
{
- return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND));
+ return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DOACROSS));
}
/* omp allocate (list) [clause-list]
@@ -7847,18 +7900,16 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
if (list == OMP_LIST_DEPEND)
{
- if (n->u.depend_op == OMP_DEPEND_SINK_FIRST
- || n->u.depend_op == OMP_DEPEND_SINK)
+ if (n->u.depend_doacross_op == OMP_DEPEND_SINK_FIRST
+ || n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST
+ || n->u.depend_doacross_op == OMP_DOACROSS_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)
+ if (omp_clauses->doacross_source)
{
- gfc_error ("DEPEND SINK used together with "
- "DEPEND SOURCE on the same construct "
- "at %L", &n->where);
- omp_clauses->depend_source = false;
+ gfc_error ("Dependence-type SINK used together with"
+ " SOURCE on the same construct at %L",
+ &n->where);
+ omp_clauses->doacross_source = false;
}
else if (n->expr)
{
@@ -7868,13 +7919,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_error ("SINK addend not a constant integer "
"at %L", &n->where);
}
+ if (n->sym == NULL
+ && (n->expr == NULL
+ || mpz_cmp_si (n->expr->value.integer, -1) != 0))
+ gfc_error ("omp_cur_iteration at %L requires %<-1%> "
+ "as logical offset", &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);
- else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+ else if (n->u.depend_doacross_op == OMP_DEPEND_DEPOBJ
&& !n->expr
&& (n->sym->ts.type != BT_INTEGER
|| n->sym->ts.kind
@@ -7884,7 +7936,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"type shall be a scalar integer of "
"OMP_DEPEND_KIND kind", n->sym->name,
&n->where);
- else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+ else if (n->u.depend_doacross_op == OMP_DEPEND_DEPOBJ
&& n->expr
&& (!gfc_resolve_expr (n->expr)
|| n->expr->ts.type != BT_INTEGER
@@ -8543,9 +8595,6 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
resolve_scalar_int_expr (el->expr, "WAIT");
if (omp_clauses->collapse && omp_clauses->tile_list)
gfc_error ("Incompatible use of TILE and COLLAPSE at %L", &code->loc);
- 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 (omp_clauses->message)
{
gfc_expr *expr = omp_clauses->message;
@@ -10541,6 +10590,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_CANCEL:
case EXEC_OMP_ERROR:
case EXEC_OMP_MASKED:
+ case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_MASKED:
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index cb2d0ee7c83..b35d76a4f6b 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1037,7 +1037,8 @@ decode_omp_directive (void)
matcho ("loop", gfc_match_omp_loop, ST_OMP_LOOP);
break;
case 'o':
- if (gfc_match ("ordered depend (") == MATCH_YES)
+ if (gfc_match ("ordered depend (") == MATCH_YES
+ || gfc_match ("ordered doacross (") == MATCH_YES)
{
gfc_current_locus = old_locus;
if (!flag_openmp)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index a4d75b19921..4105db6aa24 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -4259,15 +4259,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gfc_init_block (&iter_block);
prev = n;
if (list == OMP_LIST_DEPEND
- && n->u.depend_op == OMP_DEPEND_SINK_FIRST)
+ && (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST
+ || n->u.depend_doacross_op == OMP_DEPEND_SINK_FIRST))
{
tree vec = NULL_TREE;
unsigned int i;
+ bool is_depend
+ = n->u.depend_doacross_op == OMP_DEPEND_SINK_FIRST;
for (i = 0; ; i++)
{
tree addend = integer_zero_node, t;
bool neg = false;
- if (n->expr)
+ if (n->sym && n->expr)
{
addend = gfc_conv_constant_to_tree (n->expr);
if (TREE_CODE (addend) == INTEGER_CST
@@ -4278,7 +4281,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
TREE_TYPE (addend), addend);
}
}
- t = gfc_trans_omp_variable (n->sym, false);
+
+ if (n->sym == NULL)
+ t = null_pointer_node; /* "omp_cur_iteration - 1". */
+ else
+ t = gfc_trans_omp_variable (n->sym, false);
if (t != error_mark_node)
{
if (i < vec_safe_length (doacross_steps)
@@ -4295,7 +4302,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_DOACROSS_SINK_NEGATIVE (vec) = 1;
}
if (n->next == NULL
- || n->next->u.depend_op != OMP_DEPEND_SINK)
+ || n->next->u.depend_doacross_op != OMP_DOACROSS_SINK)
break;
n = n->next;
}
@@ -4305,7 +4312,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree node = build_omp_clause (input_location,
OMP_CLAUSE_DOACROSS);
OMP_CLAUSE_DOACROSS_KIND (node) = OMP_CLAUSE_DOACROSS_SINK;
- OMP_CLAUSE_DOACROSS_DEPEND (node) = 1;
+ OMP_CLAUSE_DOACROSS_DEPEND (node) = is_depend;
OMP_CLAUSE_DECL (node) = nreverse (vec);
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
continue;
@@ -4357,7 +4364,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
}
if (list == OMP_LIST_DEPEND)
- switch (n->u.depend_op)
+ switch (n->u.depend_doacross_op)
{
case OMP_DEPEND_IN:
OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
@@ -5762,11 +5769,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
- if (clauses->depend_source)
+ if (clauses->doacross_source)
{
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DOACROSS);
OMP_CLAUSE_DOACROSS_KIND (c) = OMP_CLAUSE_DOACROSS_SOURCE;
- OMP_CLAUSE_DOACROSS_DEPEND (c) = 1;
+ OMP_CLAUSE_DOACROSS_DEPEND (c) = clauses->depend_source;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
@@ -6657,7 +6664,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
init = make_tree_vec (collapse);
cond = make_tree_vec (collapse);
incr = make_tree_vec (collapse);
- orig_decls = clauses->orderedc ? make_tree_vec (collapse) : NULL_TREE;
+ orig_decls = clauses->ordered ? make_tree_vec (collapse) : NULL_TREE;
if (pblock == NULL)
{
@@ -6757,6 +6764,10 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
MODIFY_EXPR,
type, dovar,
TREE_VEC_ELT (incr, i));
+ if (orig_decls && !clauses->orderedc)
+ orig_decls = NULL;
+ else if (orig_decls)
+ TREE_VEC_ELT (orig_decls, i) = dovar_decl;
}
else
{
@@ -6797,9 +6808,9 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
vec_safe_grow_cleared (doacross_steps, clauses->orderedc, true);
(*doacross_steps)[i] = step;
}
+ if (orig_decls)
+ TREE_VEC_ELT (orig_decls, i) = dovar_decl;
}
- if (orig_decls)
- TREE_VEC_ELT (orig_decls, i) = dovar_decl;
if (dovar_found == 3
&& op == EXEC_OMP_SIMD
@@ -7170,7 +7181,7 @@ gfc_trans_omp_depobj (gfc_code *code)
int k = -1; /* omp_clauses->destroy */
if (!code->ext.omp_clauses->destroy)
switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET
- ? code->ext.omp_clauses->depobj_update : n->u.depend_op)
+ ? code->ext.omp_clauses->depobj_update : n->u.depend_doacross_op)
{
case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
case OMP_DEPEND_OUT: k = GOMP_DEPEND_OUT; break;
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 9daad25790f..125f17bac2f 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,14 @@
+2022-09-05 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline:
+ 2022-09-05 Tobias Burnus <tobias@codesourcery.com>
+
+ * gfortran.dg/gomp/all-memory-1.f90: Update dg-error.
+ * gfortran.dg/gomp/depend-iterator-2.f90: Likewise.
+ * gfortran.dg/gomp/depobj-2.f90: Likewise.
+ * gfortran.dg/gomp/doacross-5.f90: New test.
+ * gfortran.dg/gomp/doacross-6.f90: New test.
+
2022-09-05 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline:
diff --git a/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 b/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90
index f8f34f0c887..51b5633adba 100644
--- a/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90
@@ -50,5 +50,5 @@ subroutine f6
!$omp target depend ( depobj : omp_all_memory) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" }
!!$omp end target
- !$omp ordered depend ( sink : omp_all_memory) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" }
+ !$omp ordered depend ( sink : omp_all_memory) ! { dg-error "used with dependence-type other than OUT or INOUT" }
end
diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
index 21fc3272974..cadd9a06cfe 100644
--- a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
@@ -34,7 +34,7 @@ program main
!!$omp end task
!$omp task depend(iterator(i=1:5), source ) ! { dg-error "ITERATOR may not be combined with SOURCE" }
!!$omp end task
- !$omp task affinity (iterator(i=1:5): a) depend(iterator(i=1:5), sink : x) ! { dg-error "ITERATOR may not be combined with SINK" }
+ !$omp task affinity (iterator(i=1:5): a) depend(iterator(i=1:5), sink : x) ! { dg-error "SINK at .1. not permitted as dependence-type for this directive" }
!!$omp end task
end do
diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
index cb67c3ce9d1..6e7441d8d00 100644
--- a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
@@ -21,13 +21,13 @@ subroutine f1
!$omp depobj(d) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
!$omp depobj(depobj) depend( inout : a, b) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall have only a single locator" }
!$omp depobj(depobj) depend(mutexinoutset : a) ! OK
- !$omp depobj(depobj) depend(source) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
- !$omp depobj(depobj) depend(sink : i + 1) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+ !$omp depobj(depobj) depend(source) ! { dg-error "SOURCE at .1. not permitted as dependence-type for this directive" }
+ !$omp depobj(depobj) depend(sink : i + 1) ! { dg-error "SINK at .1. not permitted as dependence-type for this directive" }
!$omp depobj(depobj) update(source) ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" }
!$omp depobj(depobj) update(sink) ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" }
!$omp depobj(depobj) update(depobj) ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" }
! Valid in OpenMP 5.1:
- !$omp depobj(depobj5) depend(depobj: depobj3) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+ !$omp depobj(depobj5) depend(depobj: depobj3) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type DEPOBJ" }
end subroutine f1
diff --git a/gcc/testsuite/gfortran.dg/gomp/doacross-5.f90 b/gcc/testsuite/gfortran.dg/gomp/doacross-5.f90
new file mode 100644
index 00000000000..3a1679a1eec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/doacross-5.f90
@@ -0,0 +1,88 @@
+subroutine foo (n)
+ integer i, n
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(source:)
+ !$omp ordered doacross(sink: i - 2)
+ end do
+end
+
+subroutine bar (n)
+ integer :: i, j, n
+
+ !$omp do collapse(2) ordered(2)
+ do i = 1, 8, n
+ do j = 1, 8, n
+ !$omp ordered doacross(source:omp_cur_iteration)
+ !$omp ordered doacross(sink: i - 2, j + 2)
+ end do
+ end do
+end
+
+subroutine baz ()
+ integer :: i, j
+
+ !$omp do ordered(1)
+ do i = 1, 64
+ !$omp ordered ! { dg-error "'ordered' construct without 'doacross' or 'depend' clauses must not have the same binding region as 'ordered' construct with those clauses" }
+ !$omp end ordered
+
+ !$omp ordered doacross(source:)
+
+ !$omp ordered doacross(sink: i - 1)
+ end do
+
+ !$omp do ordered
+ do i = 1, 64
+ !$omp ordered doacross(source: omp_cur_iteration )
+
+ !$omp ordered doacross(sink: i - 1)
+
+ !$omp ordered threads ! { dg-error "'ordered' construct without 'doacross' or 'depend' clauses must not have the same binding region as 'ordered' construct with those clauses" }
+ !$omp end ordered
+ end do
+ !$omp do ordered(2)
+ do i = 1, 64
+ do j = 1, 64
+ !$omp ordered ! { dg-error "'ordered' construct without 'doacross' or 'depend' clauses binds to loop where 'collapse' argument 1 is different from 'ordered' argument 2" }
+ !$omp end ordered
+ end do
+ end do
+ !$omp do ordered(2) collapse(1)
+ do i = 1, 8
+ do j = 1, 8
+ !$omp ordered threads ! { dg-error "'ordered' construct without 'doacross' or 'depend' clauses binds to loop where 'collapse' argument 1 is different from 'ordered' argument 2" }
+ !$omp end ordered
+ end do
+ end do
+end
+
+subroutine qux ()
+ integer :: i, j
+ j = 0
+ !$omp do ordered linear(j)
+ do i = 1, 64
+ j = j + 1
+ !$omp ordered
+ !$omp end ordered
+ end do
+ !$omp do ordered linear(j) ! { dg-error "'linear' clause may not be specified together with 'ordered' clause if stand-alone 'ordered' construct is nested in it" }
+ do i = 1, 64
+ j = j + 1
+ !$omp ordered doacross(source:)
+ !$omp ordered doacross(sink:i-1)
+ end do
+ !$omp do ordered(1) linear(j)
+ do i = 1, 64
+ j = j + 1
+ !$omp ordered
+ !$omp end ordered
+ end do
+ !$omp do ordered(1) linear(j) ! { dg-error "'linear' clause may not be specified together with 'ordered' clause if stand-alone 'ordered' construct is nested in it" }
+ do i = 1, 64
+ j = j + 1
+ !$omp ordered doacross(source:)
+ !$omp ordered doacross(sink:i-1)
+ end do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/doacross-6.f90 b/gcc/testsuite/gfortran.dg/gomp/doacross-6.f90
new file mode 100644
index 00000000000..a45e1c9386c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/doacross-6.f90
@@ -0,0 +1,77 @@
+subroutine foo (n)
+ integer :: i, n
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(source) ! { dg-error "Expected ':'" }
+ end do
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(source:omp_current_iteration) ! { dg-error "Expected '\\\)' or 'omp_cur_iteration\\\)'" }
+ end do
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(source:i - 2) ! { dg-error "Expected '\\\)' or 'omp_cur_iteration\\\)'" }
+ end do
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(sink) ! { dg-error "Expected ':'" }
+ end do
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(sink:) ! { dg-error "Syntax error in OpenMP SINK dependence-type list" }
+ end do
+end
+
+subroutine bar (n)
+ implicit none
+ integer i, n
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(sink:omp_current_iteration - 1) ! { dg-error "Symbol 'omp_current_iteration' at .1. has no IMPLICIT type" }
+ end do
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(sink:omp_cur_iteration) ! { dg-error "omp_cur_iteration at .1. requires '-1' as logical offset" }
+ end do
+end
+
+subroutine baz (n)
+ implicit none
+ integer i, n
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(sink:omp_cur_iteration + 1) ! { dg-error "omp_cur_iteration at .1. requires '-1' as logical offset" }
+ end do
+end
+
+subroutine qux (n)
+ implicit none
+ integer i, n
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(sink:omp_cur_iteration - (2 - 1)) ! { dg-error "Syntax error in OpenMP SINK dependence-type list" }
+ end do
+end
+
+subroutine corge (n)
+ implicit none
+ integer i, n
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(sink:omp_cur_iteration - 1)
+ end do
+
+ !$omp do ordered
+ do i = 1, 8, n
+ !$omp ordered doacross(sink:omp_cur_iteration - 1_8)
+ end do
+end
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 316e5ee4bbe..acbcd39cb6d 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,10 @@
+2022-09-05 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline:
+ 2022-09-05 Tobias Burnus <tobias@codesourcery.com>
+
+ * libgomp.texi (OpenMP 5.2): Update doacross/omp_cur_iteration status.
+
2022-08-30 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline:
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 77987619cf8..452eb112bd6 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -394,10 +394,11 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@item Default map-type for @code{map} clause in @code{target enter/exit data}
@tab Y @tab
@item New @code{doacross} clause as alias for @code{depend} with
- @code{source}/@code{sink} modifier @tab N @tab
+ @code{source}/@code{sink} modifier @tab Y @tab
@item Deprecation of @code{depend} with @code{source}/@code{sink} modifier
@tab N @tab
-@item @code{omp_cur_iteration} keyword @tab N @tab
+@item @code{omp_cur_iteration} keyword @tab P
+ @tab @code{sink: omp_cur_iteration - 1} unsupported
@end multitable
@unnumberedsubsec Other new OpenMP 5.2 features
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-09-05 16:25 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-09-05 16:25 [gcc/devel/omp/gcc-12] Fortran/openmp: Partial OpenMP 5.2 doacross and omp_cur_iteration support Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).