OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

OpenMP: Add omp_all_memory support to Fortran 

Fortran part to the C/C++/backend implementation
r13-337-g7f78783dbedca0183d193e475262ca3c489fd365

gcc/fortran/ChangeLog:

	* 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.

libgomp/ChangeLog:

	* 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.

gcc/testsuite/ChangeLog:

	* 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.
This commit is contained in:
Tobias Burnus 2022-05-17 11:01:04 +02:00
parent ebce0e9bd8
commit 4f94c38a92
11 changed files with 567 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/fortran/dump-parse-tree.cc
View File

@ -1423,7 +1423,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break;
default: break;
}
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)

79
gcc/fortran/openmp.cc
View File

@ -296,14 +296,17 @@ gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts)
}
/* 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;
@ -315,7 +318,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
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;
@ -323,7 +327,35 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
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:
@ -578,6 +610,12 @@ gfc_match_omp_depend_sink (gfc_omp_namelist **list)
tail->sym = sym;
tail->expr = NULL;
tail->where = cur_loc;
if (UNLIKELY (strcmp (sym->name, "omp_all_memory") == 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)
@ -1868,6 +1906,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
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)
@ -1920,21 +1959,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
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
@ -6490,6 +6535,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
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

7
gcc/fortran/resolve.cc
View File

@ -15505,6 +15505,13 @@ resolve_symbol (gfc_symbol *sym)
if (sym->attr.unlimited_polymorphic)
return;
if (UNLIKELY (flag_openmp && strcmp (sym->name, "omp_all_memory") == 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

10
gcc/fortran/trans-openmp.cc
View File

@ -2880,14 +2880,16 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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))
@ -5531,7 +5533,9 @@ gfc_trans_omp_depobj (gfc_code *code)
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)

51
gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 Normal file
View File

@ -0,0 +1,51 @@
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

52
gcc/testsuite/gfortran.dg/gomp/all-memory-2.f90 Normal file
View File

@ -0,0 +1,52 @@
! { 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

24
gcc/testsuite/gfortran.dg/gomp/all-memory-3.f90 Normal file
View File

@ -0,0 +1,24 @@
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

4
libgomp/libgomp.texi
View File

@ -274,7 +274,7 @@ The OpenMP 4.5 specification is fully supported.
@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
@ -283,7 +283,7 @@ The OpenMP 4.5 specification is fully supported.
@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

121
libgomp/testsuite/libgomp.fortran/depend-5.f90 Normal file
View File

@ -0,0 +1,121 @@
! { 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

126
libgomp/testsuite/libgomp.fortran/depend-6.f90 Normal file
View File

@ -0,0 +1,126 @@
! { 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

113
libgomp/testsuite/libgomp.fortran/depend-7.f90 Normal file
View File

@ -0,0 +1,113 @@
! { 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