Chung-Lin Tang wrote:
This patch fixes a case where POINTER attribute arrays are deep copied when not
supposed to.
Namely, OpenMP states for the "firstprivate Clause":
"If an original list item has the POINTER attribute, the new list
items receive the same association status as the original list
item, as if by pointer assignment."
That's what currently happens for data-sharing constructs but not
for mapping (i.e. the 'target' construct). And the latter is what
this patch actually fixes!
Currently, also the pointer target gets privatized - but only for
arrays, scalar pointers behave as prescribed. If the pointee/pointer
target is device accessible (i.e. either device pointer or a host
pointer but device accessible), this is detectable as the modification
must survive the target region – while modifying the pointer association
shall not survive.
* * *
Side remark: This patch has no effect on OpenACC, which already
shows the behavior of OpenMP with this patch applied: The pointer
is privatized, but not the pointer target (pointee).
I have not checked in depth how OpenACC required to handles such
variables nor how GCC does, but as this patch doesn't touch this
part ...
* * *
This creates a new langhook 'omp_array_data_privatize' to differentiate cases
in certain
places during omp-low.
The existing lang hook omp_array_data and the new langhook
omp_array_data_privatize are both only active for Fortran
for variables with array descriptor. The former handling
all such variables (assumed-shape dummy arguments, allocatable
and pointer variables, dummy variables or not), the new one only
handles non-pointer variables.
The existing code is invoked for 'firstprivatize' - but pointee
privatization does not happen for 'has_device_addr'
* * *
+/* Returns true if it is an array descriptor where the data is to be copied
s/it/DECL/
+ and privatized. Assumes the above 'omp_array_data' to already be true
+ (hence the assertion of descriptor type here). */
+bool
+gfc_omp_array_data_privatize (tree decl)
I am completely happy with that wording - maybe the following is
clearer?
Returns true if DECL is an array for which the actual array data
has to be privatized; the caller must ensure that DECL is an
array descriptor, i.e. 'omp_array_data' returns true.
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index 6eb5c1602f8..aa983165ab5 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -243,6 +243,10 @@ struct lang_hooks_for_decls
is true, only the TREE_TYPE is returned without generating a new tree.
*/
tree (*omp_array_data) (tree, bool);
+ /* Return true if the data of an array descriptor is to be copied and
+ privatized. Assumes omp_array_data returns non-NULL_TREE. */
+ bool (*omp_array_data_privatize) (tree);
+
Maybe:
Return true if the actual array data of the passed array descriptor decl
shall be privatized as well, otherwise only the array descriptor is to
be privatized. The argument must be a decl for an array descriptor,
i.e. it may only be called for a decl for which omp_array_data returns
a non-NULL_TREE.
* * *
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr122910.f90
@@ -0,0 +1,23 @@
+! { dg-do run { target { ! offload_device } } }
There is no need for "target { ! offload_device }".
As the code contains ...
+program main
+ implicit none
+
+ !$omp requires self_maps
it either runs on the host (host fallback), if unified-shared memory
is not not supported (including having no offload configured).
Or is runs on the device, if detected as supported. - Either should be
fine.
The firstprivatization feature also must work in host-fallback mode,
i.e. it makes sense to remove the '! offload_device' to check it also
on non-offload systems.
* * *
I think it would be good to also check allocatables and assumed-shape
arrays, ensuring that those work.
And we probably should check data-sharing attributes as well,
e.g.
!$omp parallel firstprivate(fptr)
!$omp masked
fptr = fptr * 10
!$omp end masked
!$omp end parallel
if (any (fptr /= 10*5*[1,2,3,4,5])) stop 2
And likewise for an 'allocatable' variable to see that this one
remains the same.
* * *
→ Except for considering some comment tweaks to make it clearer
what the function does + extending the test case for not-tested-for
but working cases:
LGTM. Thanks for the patch and sorry for the slow review.
Tobias
PS: For the last item, I was thinking of something like the
attached testcase. That's your testcase, extended to check for
a bit more. I tested it with your patch applied, both with a
GCC not configured for offloading and one with offloading,
running on an Nvidia GPU that supports unified-shared memory.! { dg-do run }
program main
implicit none
!$omp requires self_maps
integer :: i
INTEGER, POINTER :: fptr(:)
INTEGER, ALLOCATABLE :: alloc_array(:)
integer, parameter :: N = 5
ALLOCATE(fptr(N))
fptr = 7
alloc_array = [1,2,3,4,5,6]
!$omp target firstprivate(fptr, alloc_array)
DO i=1, N
fptr(i) = 5*i + fptr(i)
END DO
fptr => null() ! ptr must be privatized, pointer target not
if (any (alloc_array /= [1,2,3,4,5,6])) stop 1
alloc_array = alloc_array * 21
!$omp end target
! pointer array: values shall be updated
if (any (fptr /= 7 + 5*[1,2,3,4,5])) stop 2
! allocatables: shall not be updated
if (any (alloc_array /= [1,2,3,4,5,6])) stop 3
! Check data-sharing constructs as well:
!$omp parallel firstprivate(fptr, alloc_array)
!$omp masked
fptr = fptr * 10
fptr => null()
if (any (alloc_array /= [1,2,3,4,5,6])) stop 4
alloc_array = alloc_array * 21
!$omp end masked
!$omp end parallel
if (any (fptr /= (7 + 5*[1,2,3,4,5])*10)) stop 5
if (any (alloc_array /= [1,2,3,4,5,6])) stop 6
call assumed_shape(alloc_array, N)
DEALLOCATE(fptr, alloc_array)
contains
subroutine assumed_shape(x, m)
integer, value :: m
integer :: x(:)
integer :: y(m)
integer, save :: z(5)
y = [11,22,33,44,55]
z = [111,222,333,444,555]
!$omp target firstprivate(x,y,z)
if (any (x /= [1,2,3,4,5,6])) stop 7
if (any (y /= [11,22,33,44,55])) stop 8
if (any (z /= [111,222,333,444,555])) stop 9
x = 31 * x
y = 47 * y
z = 53 * z
!$omp end target
if (any (x /= [1,2,3,4,5,6])) stop 10
if (any (y /= [11,22,33,44,55])) stop 11
if (any (z /= [111,222,333,444,555])) stop 12
!$omp parallel firstprivate(x,y,z) if(.false.)
if (any (x /= [1,2,3,4,5,6])) stop 13
if (any (y /= [11,22,33,44,55])) stop 14
if (any (z /= [111,222,333,444,555])) stop 15
x = 31 * x
y = 47 * y
z = 53 * z
!$omp end parallel
if (any (x /= [1,2,3,4,5,6])) stop 16
if (any (y /= [11,22,33,44,55])) stop 17
if (any (z /= [111,222,333,444,555])) stop 18
end subroutine
end program
