+2022-07-04 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline:
+ 2022-05-17 Tobias Burnus <tobias@codesourcery.com>
+
+ * trans-openmp.cc (gfc_trans_omp_clauses): When mapping nondescriptor
+ array sections, use GOMP_MAP_FIRSTPRIVATE_POINTER instead of
+ GOMP_MAP_POINTER for the pointer attachment.
+
+ * dump-parse-tree.cc (show_omp_namelist): Handle omp_all_memory.
+ * openmp.cc (gfc_match_omp_variable_list, gfc_match_omp_depend_sink,
+ gfc_match_omp_clauses, resolve_omp_clauses): Likewise.
+ * trans-openmp.cc (gfc_trans_omp_clauses, gfc_trans_omp_depobj):
+ Likewise.
+ * resolve.cc (resolve_symbol): Reject it as symbol.
+
2022-07-04 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline:
fputc (',', dumpfile);
continue;
}
- fprintf (dumpfile, "%s", n->sym->name);
+ fprintf (dumpfile, "%s", n->sym ? n->sym->name : "omp_all_memory");
if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT)
fputc (')', dumpfile);
if (n->expr)
}
-/* Match a variable/common block list and construct a namelist from it. */
+/* Match a variable/common block list and construct a namelist from it;
+ if has_all_memory != NULL, *has_all_memory is set and omp_all_memory
+ yields a list->sym NULL entry. */
static match
gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
bool allow_common, bool *end_colon = NULL,
gfc_omp_namelist ***headp = NULL,
bool allow_sections = false,
- bool allow_derived = false)
+ bool allow_derived = false,
+ bool *has_all_memory = NULL)
{
gfc_omp_namelist *head, *tail, *p;
locus old_loc, cur_loc;
head = tail = NULL;
old_loc = gfc_current_locus;
-
+ if (has_all_memory)
+ *has_all_memory = false;
m = gfc_match (str);
if (m != MATCH_YES)
return m;
for (;;)
{
cur_loc = gfc_current_locus;
- m = gfc_match_symbol (&sym, 1);
+
+ m = gfc_match_name (n);
+ if (m == MATCH_YES && strcmp (n, "omp_all_memory") == 0)
+ {
+ if (!has_all_memory)
+ {
+ gfc_error ("%<omp_all_memory%> at %C not permitted in this "
+ "clause");
+ goto cleanup;
+ }
+ *has_all_memory = true;
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->where = cur_loc;
+ goto next_item;
+ }
+ if (m == MATCH_YES)
+ {
+ gfc_symtree *st;
+ if ((m = gfc_get_ha_sym_tree (n, &st) ? MATCH_ERROR : MATCH_YES)
+ == MATCH_YES)
+ sym = st->n.sym;
+ }
switch (m)
{
case MATCH_YES:
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)
if ((mask & OMP_CLAUSE_DEPEND)
&& gfc_match ("depend ( ") == MATCH_YES)
{
+ bool has_omp_all_memory;
gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
match m_it = gfc_match_iterator (&ns_iter, false);
if (m_it == MATCH_ERROR)
if (m == MATCH_YES)
m = gfc_match_omp_variable_list (" : ",
&c->lists[OMP_LIST_DEPEND],
- false, NULL, &head, true);
+ false, NULL, &head, true,
+ false, &has_omp_all_memory);
+ if (m != MATCH_YES)
+ goto error;
gfc_current_ns = ns_curr;
- if (m == MATCH_YES)
+ if (has_omp_all_memory && depend_op != OMP_DEPEND_INOUT
+ && depend_op != OMP_DEPEND_OUT)
{
- gfc_omp_namelist *n;
- for (n = *head; n; n = n->next)
- {
- n->u.depend_op = depend_op;
- n->u2.ns = ns_iter;
- if (ns_iter)
- ns_iter->refs++;
- }
- continue;
+ gfc_error ("%<omp_all_memory%> used with DEPEND kind "
+ "other than OUT or INOUT at %C");
+ goto error;
}
- break;
+ gfc_omp_namelist *n;
+ for (n = *head; n; n = n->next)
+ {
+ n->u.depend_op = depend_op;
+ n->u2.ns = ns_iter;
+ if (ns_iter)
+ ns_iter->refs++;
+ }
+ continue;
}
if ((mask & OMP_CLAUSE_DETACH)
&& !openacc
for (list = 0; list < OMP_LIST_NUM; list++)
for (n = omp_clauses->lists[list]; n; n = n->next)
{
+ if (!n->sym) /* omp_all_memory. */
+ continue;
n->sym->mark = 0;
n->sym->comp_mark = 0;
if (n->sym->attr.flavor == FL_VARIABLE
if (sym->attr.unlimited_polymorphic)
return;
+ if (__builtin_expect (flag_openmp && strcmp (sym->name, "omp_all_memory")
+ == 0, 0))
+ {
+ gfc_error ("%<omp_all_memory%>, declared at %L, may only be used in "
+ "the OpenMP DEPEND clause", &sym->declared_at);
+ return;
+ }
+
if (sym->attr.flavor == FL_UNKNOWN
|| (sym->attr.flavor == FL_PROCEDURE && !sym->attr.intrinsic
&& !sym->attr.generic && !sym->attr.external
continue;
}
- if (!n->sym->attr.referenced)
+ if (n->sym && !n->sym->attr.referenced)
continue;
tree node = build_omp_clause (input_location,
list == OMP_LIST_DEPEND
? OMP_CLAUSE_DEPEND
: OMP_CLAUSE_AFFINITY);
- if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
+ if (n->sym == NULL) /* omp_all_memory */
+ OMP_CLAUSE_DECL (node) = null_pointer_node;
+ else if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
tree decl = gfc_trans_omp_variable (n->sym, false);
if (gfc_omp_privatize_by_reference (decl))
if (n)
{
tree var;
- if (n->expr && n->expr->ref->u.ar.type != AR_FULL)
+ if (!n->sym) /* omp_all_memory. */
+ var = null_pointer_node;
+ else if (n->expr && n->expr->ref->u.ar.type != AR_FULL)
{
gfc_init_se (&se, NULL);
if (n->expr->ref->u.ar.type == AR_ELEMENT)
+2022-07-04 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline:
+ 2022-05-17 Tobias Burnus <tobias@codesourcery.com>
+
+ * gfortran.dg/gomp/all-memory-1.f90: New test.
+ * gfortran.dg/gomp/all-memory-2.f90: New test.
+ * gfortran.dg/gomp/all-memory-3.f90: New test.
+
2022-06-27 Tobias Burnus <tobias@codesourcery.com>
* gfortran.dg/gomp/num-teams-2.f90: Use dg-error not dg-warning.
--- /dev/null
+module m
+ integer :: omp_all_memory ! { dg-error "'omp_all_memory', declared at .1., may only be used in the OpenMP DEPEND clause" }
+end module m
+
+subroutine f1
+ integer :: omp_all_memory ! { dg-error "'omp_all_memory', declared at .1., may only be used in the OpenMP DEPEND clause" }
+ !$omp target depend(out: omp_all_memory)
+ !$omp end target
+end
+
+subroutine f2
+ dimension :: omp_all_memory(5) ! { dg-error "'omp_all_memory', declared at .1., may only be used in the OpenMP DEPEND clause" }
+ !$omp target depend(out: omp_all_memory)
+ !$omp end target
+end
+
+subroutine f3
+ integer :: A
+ !$omp target depend(out: omp_all_memory) ! OK
+ omp_all_memory = 5 ! { dg-error "'omp_all_memory', declared at .1., may only be used in the OpenMP DEPEND clause" }
+ !$omp end target
+end
+
+subroutine f4
+ !$omp target map(to: omp_all_memory) ! { dg-error "'omp_all_memory' at .1. not permitted in this clause" }
+ ! !$omp end target
+
+ !$omp task private (omp_all_memory) ! { dg-error "'omp_all_memory' at .1. not permitted in this clause" }
+ ! !$omp end task
+end
+
+subroutine f5 ! OK
+ !$omp target depend(inout : omp_all_memory )
+ !$omp end target
+
+ !$omp target depend ( out : omp_all_memory)
+ !$omp end target
+end
+
+subroutine f6
+ !$omp target depend(in : omp_all_memory ) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" }
+ ! !$omp end target
+
+ !$omp target depend(mutexinoutset : omp_all_memory ) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" }
+ ! !$omp end target
+
+ !$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" }
+end
--- /dev/null
+! { dg-additional-options "-fno-openmp" }
+module m
+ integer :: omp_all_memory
+end module m
+
+subroutine f1
+ integer :: omp_all_memory
+ !$omp target depend(out: omp_all_memory)
+ !$omp end target
+end
+
+subroutine f2
+ dimension :: omp_all_memory(5)
+ !$omp target depend(out: omp_all_memory)
+ !$omp end target
+end
+
+subroutine f3
+ integer :: A
+ !$omp target depend(out: omp_all_memory)
+ omp_all_memory = 5
+ !$omp end target
+end
+
+subroutine f4
+ !$omp target map(to: omp_all_memory)
+ ! !$omp end target
+
+ !$omp task private (omp_all_memory)
+ ! !$omp end task
+end
+
+subroutine f5
+ !$omp target depend(inout : omp_all_memory )
+ !$omp end target
+
+ !$omp target depend ( out : omp_all_memory)
+ !$omp end target
+end
+
+subroutine f6
+ !$omp target depend(in : omp_all_memory )
+ ! !$omp end target
+
+ !$omp target depend(mutexinoutset : omp_all_memory )
+ ! !$omp end target
+
+ !$omp target depend ( depobj : omp_all_memory)
+ !$omp end target
+
+ !$omp ordered depend ( sink : omp_all_memory)
+end
--- /dev/null
+module m
+ use iso_c_binding
+ implicit none
+ integer, parameter :: omp_depend_kind = 2*c_size_t
+
+ integer(omp_depend_kind) :: z
+contains
+
+subroutine foo
+ integer :: x, y
+ x = 0; y = 0
+ !$omp task depend(out: omp_all_memory)
+ block; end block
+ !$omp task depend(inout: omp_all_memory)
+ block; end block
+ !$omp task depend(out: x, omp_all_memory, y)
+ block; end block
+ !$omp task depend(inout: omp_all_memory, y)
+ block; end block
+ !$omp task depend(out: x, omp_all_memory)
+ block; end block
+ !$omp depobj (z) depend (inout: omp_all_memory)
+end
+end
+2022-07-04 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline:
+ 2022-05-17 Tobias Burnus <tobias@codesourcery.com>
+
+ * libgomp.texi (OpenMP 5.1): Set omp_all_memory to 'Y'.
+ * testsuite/libgomp.fortran/depend-5.f90: New test.
+ * testsuite/libgomp.fortran/depend-6.f90: New test.
+ * testsuite/libgomp.fortran/depend-7.f90: New test.
+
2022-07-04 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline:
@multitable @columnfractions .60 .10 .25
@headitem Description @tab Status @tab Comments
@item OpenMP directive as C++ attribute specifiers @tab Y @tab
-@item @code{omp_all_memory} reserved locator @tab N @tab
+@item @code{omp_all_memory} reserved locator @tab Y @tab
@item @emph{target_device trait} in OpenMP Context @tab N @tab
@item @code{target_device} selector set in context selectors @tab N @tab
@item C/C++'s @code{declare variant} directive: elision support of
@code{append_args} @tab N @tab
@item @code{dispatch} construct @tab N @tab
@item device-specific ICV settings the environment variables @tab N @tab
-@item assume directive @tab N @tab
+@item @code{assume} directive @tab N @tab
@item @code{nothing} directive @tab Y @tab
@item @code{error} directive @tab Y @tab
@item @code{masked} construct @tab Y @tab
--- /dev/null
+! { dg-additional-sources my-usleep.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+
+module m
+ implicit none
+
+ interface
+ subroutine usleep(t) bind(C, name="my_usleep")
+ use iso_c_binding
+ integer(c_int), value :: t
+ end subroutine
+ end interface
+
+contains
+subroutine test (ifval)
+ logical, value :: ifval
+ integer :: a(0:7), b(0:7), i
+
+ do i = 0, 7
+ a(i) = i
+ b(i) = 2 * i
+ end do
+ !$omp parallel
+ block
+ !$omp single
+ block
+ !$omp task shared(a) depend(in: a(0))
+ block
+ call usleep (5000)
+ a(0) = 42
+ end block
+ !$omp task shared(a) depend(out: a(1))
+ block
+ call usleep (5000)
+ a(1) = 43
+ end block
+ !$omp task shared(a) depend(inout: a(2))
+ block
+ call usleep (5000)
+ a(2) = 44
+ end block
+ !$omp task shared(a) depend(mutexinoutset: a(3))
+ block
+ call usleep (5000)
+ a(3) = 45
+ end block
+ !$omp task shared(a)
+ block
+ call usleep (15000)
+ a(4) = 46
+ end block
+ !$omp task shared(b) depend(in: b(0))
+ block
+ call usleep (5000)
+ b(0) = 47
+ end block
+ !$omp task shared(b) depend(in: b(4))
+ block
+ call usleep (5000)
+ b(4) = 48
+ end block
+ ! None of the above tasks depend on each other.
+ ! The following task depends on all but the a(4) = 46; one.
+ !$omp task shared(a, b) depend(out: omp_all_memory) private(i) if(ifval)
+ block
+ if (a(0) /= 42 .or. a(1) /= 43 .or. a(2) /= 44 .or. a(3) /= 45 &
+ .or. a(5) /= 5 .or. a(6) /= 6 .or. a(7) /= 7 &
+ .or. b(0) /= 47 .or. b(1) /= 2 .or. b(2) /= 4 .or. b(3) /= 6 &
+ .or. b(4) /= 48 .or. b(5) /= 10 .or. b(6) /= 12 .or. b(7) /= 14) &
+ error stop
+ do i = 0, 7
+ if (i /= 4) &
+ a(i) = 3 * i + 7
+ end do
+ do i = 0, 7
+ b(i) = 4 * i - 7
+ end do
+ end block
+ ! The following task depends on both b(0) = 47; and
+ ! above omp_all_memory tasks, but as the latter depends on
+ ! the former, effectively it is dependent just on the omp_all_memory
+ ! task.
+ !$omp task shared(b) depend(inout: b(0))
+ block
+ call usleep (5000)
+ b(0) = 49
+ end block
+ ! The following task depends on all the above except a(4) = 46; one,
+ ! but it can be reduced to dependency on the above omp_all_memory
+ ! one and b(0) = 49; one.
+ !$omp task shared(a, b) depend(inout: b(7), omp_all_memory, b(6)) &
+ !$omp& private(i) if(ifval)
+ block
+ do i = 0, 7
+ if (i /= 4) then
+ if (a(i) /= 3 * i + 7) &
+ error stop
+ a(i) = 5 * i + 50
+ end if
+ end do
+ if (b(0) /= 49) &
+ error stop
+ b(0) = 6 * i + 57
+ do i = 1, 7
+ if (b(i) /= 4 * i - 7) &
+ error stop
+ b(i) = 6 * i + 57
+ end do
+ end block
+ !$omp taskwait
+ if (a(4) /= 46) &
+ error stop
+ end block ! end single
+ end block ! end parallel
+end
+end module m
+
+use m
+call test(.true.)
+call test(.false.)
+end
--- /dev/null
+! { dg-additional-sources my-usleep.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+
+module m
+ use omp_lib
+ implicit none
+
+ interface
+ subroutine usleep(t) bind(C, name="my_usleep")
+ use iso_c_binding
+ integer(c_int), value :: t
+ end subroutine
+ end interface
+
+contains
+subroutine test (ifval)
+ logical, value :: ifval
+ integer :: a(0:7), b(0:7), i
+ integer(omp_depend_kind) d1, d2
+ !$omp depobj (d1) depend(inout: omp_all_memory)
+ !$omp depobj (d2) depend(out: omp_all_memory)
+ do i = 0, 7
+ a(i) = i
+ b(i) = 2 * i
+ end do
+ !$omp parallel
+ block
+ !$omp single
+ block
+ !$omp task shared(a) depend(in: a(0))
+ block
+ call usleep (5000)
+ a(0) = 42
+ end block
+ !$omp task shared(a) depend(out: a(1))
+ block
+ call usleep (5000)
+ a(1) = 43
+ end block
+ !$omp task shared(a) depend(inout: a(2))
+ block
+ call usleep (5000)
+ a(2) = 44
+ end block
+ !$omp task shared(a) depend(mutexinoutset: a(3))
+ block
+ call usleep (5000)
+ a(3) = 45
+ end block
+ !$omp task shared(a)
+ block
+ call usleep (15000)
+ a(4) = 46
+ end block
+ !$omp task shared(b) depend(in: b(0))
+ block
+ call usleep (5000)
+ b(0) = 47
+ end block
+ !$omp task shared(b) depend(in: b(4))
+ block
+ call usleep (5000)
+ b(4) = 48
+ end block
+ ! None of the above tasks depend on each other.
+ ! The following task depends on all but the a(4) = 46; one.
+ !$omp task shared(a, b) depend(depobj: d1) private(i) if(ifval)
+ block
+ if (a(0) /= 42 .or. a(1) /= 43 .or. a(2) /= 44 .or. a(3) /= 45 &
+ .or. a(5) /= 5 .or. a(6) /= 6 .or. a(7) /= 7 &
+ .or. b(0) /= 47 .or. b(1) /= 2 .or. b(2) /= 4 .or. b(3) /= 6 &
+ .or. b(4) /= 48 .or. b(5) /= 10 .or. b(6) /= 12 .or. b(7) /= 14) &
+ error stop
+ do i = 0, 7
+ if (i /= 4) &
+ a(i) = 3 * i + 7
+ end do
+ do i = 0, 7
+ b(i) = 4 * i - 7
+ end do
+ end block
+ ! The following task depends on both b(0) = 47; and
+ ! above omp_all_memory tasks, but as the latter depends on
+ ! the former, effectively it is dependent just on the omp_all_memory
+ ! task.
+ !$omp task shared(b) depend(inout: b(0))
+ block
+ call usleep (5000)
+ b(0) = 49
+ end block
+ ! The following task depends on all the above except a(4) = 46; one,
+ ! but it can be reduced to dependency on the above omp_all_memory
+ ! one and b(0) = 49; one.
+ !$omp task shared(a, b) depend(inout: b(6)) depend(depobj: d2) &
+ !$omp& depend(out: b(7)) private(i) if(ifval)
+ block
+ do i = 0, 7
+ if (i /= 4) then
+ if (a(i) /= 3 * i + 7) &
+ error stop
+ a(i) = 5 * i + 50
+ end if
+ end do
+ if (b(0) /= 49) &
+ error stop
+ b(0) = 6 * i + 57
+ do i = 1, 7
+ if (b(i) /= 4 * i - 7) &
+ error stop
+ b(i) = 6 * i + 57
+ end do
+ end block
+ !$omp taskwait
+ if (a(4) /= 46) &
+ error stop
+ end block
+ end block
+ !$omp depobj (d2) destroy
+ !$omp depobj (d1) destroy
+end
+end module m
+
+use m
+call test (.true.)
+call test (.false.)
+end
--- /dev/null
+! { dg-additional-sources my-usleep.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+
+program main
+ implicit none
+
+ interface
+ subroutine usleep(t) bind(C, name="my_usleep")
+ use iso_c_binding
+ integer(c_int), value :: t
+ end subroutine
+ end interface
+
+ integer :: a(0:7), b(0:7), i
+
+ do i = 0, 7
+ a(i) = i
+ b(i) = 2 * i
+ end do
+
+ !$omp parallel
+ block
+ !$omp single
+ block
+ !$omp task shared(a) depend(in: a(0))
+ block
+ call usleep (5000)
+ a(0) = 42
+ end block
+ !$omp task shared(a) depend(out: a(1))
+ block
+ call usleep (5000)
+ a(1) = 43
+ end block
+ !$omp task shared(a) depend(inout: a(2))
+ block
+ call usleep (5000)
+ a(2) = 44
+ end block
+ !$omp task shared(a) depend(mutexinoutset: a(3))
+ block
+ call usleep (5000)
+ a(3) = 45
+ end block
+ !$omp task shared(a)
+ block
+ call usleep (15000)
+ a(4) = 46
+ end block
+ !$omp task shared(b) depend(in: b(0))
+ block
+ call usleep (5000)
+ b(0) = 47
+ end block
+ !$omp task shared(b) depend(in: b(4))
+ block
+ call usleep (5000)
+ b(4) = 48
+ end block
+ ! None of the above tasks depend on each other.
+ ! The following task depends on all but the a(4) = 46; one.
+ !$omp task shared(a, b) depend(iterator (j=0:7), inout: omp_all_memory) private(i)
+ block
+ if (a(0) /= 42 .or. a(1) /= 43 .or. a(2) /= 44 .or. a(3) /= 45 &
+ .or. a(5) /= 5 .or. a(6) /= 6 .or. a(7) /= 7 &
+ .or. b(0) /= 47 .or. b(1) /= 2 .or. b(2) /= 4 .or. b(3) /= 6 &
+ .or. b(4) /= 48 .or. b(5) /= 10 .or. b(6) /= 12 .or. b(7) /= 14) &
+ error stop
+ do i = 0, 7
+ if (i /= 4) &
+ a(i) = 3 * i + 7
+ end do
+ do i = 0, 7
+ b(i) = 4 * i - 7
+ end do
+ end block
+ ! The following task depends on both b(0) = 47; and
+ ! above omp_all_memory tasks, but as the latter depends on
+ ! the former, effectively it is dependent just on the omp_all_memory
+ ! task.
+ !$omp task shared(b) depend(inout: b(0))
+ block
+ call usleep (5000)
+ b(0) = 49
+ end block
+ ! The following task depends on all the above except a(4) = 46; one,
+ ! but it can be reduced to dependency on the above omp_all_memory
+ ! one and b(0) = 49; one.
+ !$omp task shared(a, b) depend(inout: b(7)) depend(iterator(j=4:5), out: omp_all_memory) &
+ !$omp& depend(inout: b(6)) private(i)
+ block
+ do i = 0, 7
+ if (i /= 4) then
+ if (a(i) /= 3 * i + 7) &
+ error stop
+ a(i) = 5 * i + 50
+ end if
+ end do
+ if (b(0) /= 49) &
+ error stop
+ b(0) = 6 * i + 57
+ do i = 1, 7
+ if (b(i) /= 4 * i - 7) &
+ error stop
+ b(i) = 6 * i + 57
+ end do
+ end block
+ !$omp taskwait
+ if (a(4) /= 46) &
+ error stop
+ end block
+ end block
+end program
git://gcc.gnu.org / gcc.git / commitdiff