* Re: [PATCH] Fix Fortran deviceptr clause.
[not found] <56649633.8080803@codesourcery.com>
@ 2015-12-16 13:41 ` James Norris
0 siblings, 0 replies; only message in thread
From: James Norris @ 2015-12-16 13:41 UTC (permalink / raw)
To: GCC Patches, Jakub Jelinek, fortran
[-- Attachment #1: Type: text/plain, Size: 190 bytes --]
Hi,
This is an update of my previous patch. Cesar (thanks!)
pointed out some issues with the original patch that
have now been addressed.
Regtested on x86_64
OK for trunk?
Thanks!
Jim
[-- Attachment #2: deviceptr.patch --]
[-- Type: text/x-patch, Size: 9030 bytes --]
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 276f2f1..9350dc4 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -812,19 +812,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
OMP_MAP_ALLOC))
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
- && gfc_match ("deviceptr ( ") == MATCH_YES)
- {
- gfc_omp_namelist **list = &c->lists[OMP_LIST_MAP];
- gfc_omp_namelist **head = NULL;
- if (gfc_match_omp_variable_list ("", list, true, NULL, &head, false)
- == MATCH_YES)
- {
- gfc_omp_namelist *n;
- for (n = *head; n; n = n->next)
- n->u.map_op = OMP_MAP_FORCE_DEVICEPTR;
- continue;
- }
- }
+ && gfc_match ("deviceptr ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_DEVICEPTR))
+ continue;
if ((mask & OMP_CLAUSE_USE_DEVICE)
&& gfc_match_omp_variable_list ("use_device (",
&c->lists[OMP_LIST_USE_DEVICE], true)
diff --git a/libgomp/oacc-parallel.c b/libgomp/oacc-parallel.c
index db7cab3..98982c3 100644
--- a/libgomp/oacc-parallel.c
+++ b/libgomp/oacc-parallel.c
@@ -49,6 +49,51 @@ find_pset (int pos, size_t mapnum, unsigned short *kinds)
return kind == GOMP_MAP_TO_PSET;
}
+/* Handle the mapping pair that are presented when a
+ deviceptr clause is used with Fortran. */
+
+static void
+handle_ftn_pointers (size_t mapnum, void **hostaddrs, size_t *sizes,
+ unsigned short *kinds)
+{
+ int i;
+
+ for (i = 0; i < mapnum; i++)
+ {
+ unsigned short kind1 = kinds[i] & 0xff;
+
+ /* Handle Fortran deviceptr clause. */
+ if (kind1 == GOMP_MAP_FORCE_DEVICEPTR)
+ {
+ unsigned short kind2;
+
+ if (i < (signed)mapnum - 1)
+ kind2 = kinds[i + 1] & 0xff;
+ else
+ kind2 = 0xffff;
+
+ if (sizes[i] == sizeof (void *))
+ continue;
+
+ /* At this point, we're dealing with a Fortran deviceptr.
+ If the next element is not what we're expecting, then
+ this is an instance of where the deviceptr variable was
+ not used within the region and the pointer was removed
+ by the gimplifier. */
+ if (kind2 == GOMP_MAP_POINTER
+ && sizes[i + 1] == 0
+ && hostaddrs[i] == *(void **)hostaddrs[i + 1])
+ {
+ kinds[i+1] = kinds[i];
+ sizes[i+1] = sizeof (void *);
+ }
+
+ /* Invalidate the entry. */
+ hostaddrs[i] = NULL;
+ }
+ }
+}
+
static void goacc_wait (int async, int num_waits, va_list *ap);
@@ -88,6 +133,8 @@ GOACC_parallel_keyed (int device, void (*fn) (void *),
thr = goacc_thread ();
acc_dev = thr->dev;
+ handle_ftn_pointers (mapnum, hostaddrs, sizes, kinds);
+
/* Host fallback if "if" clause is false or if the current device is set to
the host. */
if (host_fallback)
@@ -172,8 +219,13 @@ GOACC_parallel_keyed (int device, void (*fn) (void *),
devaddrs = gomp_alloca (sizeof (void *) * mapnum);
for (i = 0; i < mapnum; i++)
- devaddrs[i] = (void *) (tgt->list[i].key->tgt->tgt_start
- + tgt->list[i].key->tgt_offset);
+ {
+ if (tgt->list[i].key != NULL)
+ devaddrs[i] = (void *) (tgt->list[i].key->tgt->tgt_start
+ + tgt->list[i].key->tgt_offset);
+ else
+ devaddrs[i] = NULL;
+ }
acc_dev->openacc.exec_func (tgt_fn, mapnum, hostaddrs, devaddrs,
async, dims, tgt);
@@ -224,6 +276,8 @@ GOACC_data_start (int device, size_t mapnum,
struct goacc_thread *thr = goacc_thread ();
struct gomp_device_descr *acc_dev = thr->dev;
+ handle_ftn_pointers (mapnum, hostaddrs, sizes, kinds);
+
/* Host fallback or 'do nothing'. */
if ((acc_dev->capabilities & GOMP_OFFLOAD_CAP_SHARED_MEM)
|| host_fallback)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
index f717d1b..2d4b707 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
@@ -1,29 +1,22 @@
! { dg-do run { target openacc_nvidia_accel_selected } }
+! Tests to exercise the declare directive along with
+! the clauses: copy
+! copyin
+! copyout
+! create
+! present
+! present_or_copy
+! present_or_copyin
+! present_or_copyout
+! present_or_create
+
module vars
implicit none
integer z
!$acc declare create (z)
end module vars
-subroutine subr6 (a, d)
- implicit none
- integer, parameter :: N = 8
- integer :: i
- integer :: a(N)
- !$acc declare deviceptr (a)
- integer :: d(N)
-
- i = 0
-
- !$acc parallel copy (d)
- do i = 1, N
- d(i) = a(i) + a(i)
- end do
- !$acc end parallel
-
-end subroutine
-
subroutine subr5 (a, b, c, d)
implicit none
integer, parameter :: N = 8
@@ -201,15 +194,6 @@ subroutine subr0 (a, b, c, d)
if (d(i) .ne. 13) call abort
end do
- call subr6 (a, d)
-
- call test (a, .true.)
- call test (d, .false.)
-
- do i = 1, N
- if (d(i) .ne. 16) call abort
- end do
-
end subroutine
program main
@@ -241,8 +225,7 @@ program main
if (a(i) .ne. 8) call abort
if (b(i) .ne. 8) call abort
if (c(i) .ne. 8) call abort
- if (d(i) .ne. 16) call abort
+ if (d(i) .ne. 13) call abort
end do
-
end program
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90
new file mode 100644
index 0000000..276a172
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90
@@ -0,0 +1,197 @@
+! { dg-do run }
+
+! Test the deviceptr clause with various directives
+! and in combination with other directives where
+! the deviceptr variable is implied.
+
+subroutine subr1 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc data deviceptr (a)
+
+ !$acc parallel copy (b)
+ do i = 1, N
+ a(i) = i * 2
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+ !$acc end data
+
+end subroutine
+
+subroutine subr2 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ !$acc declare deviceptr (a)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc parallel copy (b)
+ do i = 1, N
+ a(i) = i * 4
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr3 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ !$acc declare deviceptr (a)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc kernels copy (b)
+ do i = 1, N
+ a(i) = i * 8
+ b(i) = a(i)
+ end do
+ !$acc end kernels
+
+end subroutine
+
+subroutine subr4 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc parallel deviceptr (a) copy (b)
+ do i = 1, N
+ a(i) = i * 16
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr5 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc kernels deviceptr (a) copy (b)
+ do i = 1, N
+ a(i) = i * 32
+ b(i) = a(i)
+ end do
+ !$acc end kernels
+
+end subroutine
+
+subroutine subr6 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc parallel deviceptr (a) copy (b)
+ do i = 1, N
+ b(i) = i
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr7 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc data deviceptr (a)
+
+ !$acc parallel copy (b)
+ do i = 1, N
+ a(i) = i * 2
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ do i = 1, N
+ a(i) = b(i) * 2
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+ !$acc end data
+
+end subroutine
+
+program main
+ use iso_c_binding, only: c_ptr, c_f_pointer
+ implicit none
+ type (c_ptr) :: cp
+ integer, parameter :: N = 8
+ integer, pointer :: fp(:)
+ integer :: i = 0
+ integer :: b(N)
+
+ interface
+ function acc_malloc (s) bind (C)
+ use iso_c_binding, only: c_ptr, c_size_t
+ integer (c_size_t), value :: s
+ type (c_ptr) :: acc_malloc
+ end function
+ end interface
+
+ cp = acc_malloc (N * sizeof (fp(N)))
+ call c_f_pointer (cp, fp, [N])
+
+ call subr1 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 2) call abort
+ end do
+
+ call subr2 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 4) call abort
+ end do
+
+ call subr3 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 8) call abort
+ end do
+
+ call subr4 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 16) call abort
+ end do
+
+ call subr5 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 32) call abort
+ end do
+
+ call subr6 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i) call abort
+ end do
+
+ call subr7 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 4) call abort
+ end do
+
+end program main
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2015-12-16 13:41 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <56649633.8080803@codesourcery.com>
2015-12-16 13:41 ` [PATCH] Fix Fortran deviceptr clause James Norris
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).