public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [gomp4] Fix Fortran deviceptr
@ 2015-12-06 14:52 James Norris
  2015-12-07 15:55 ` Cesar Philippidis
  0 siblings, 1 reply; 5+ messages in thread
From: James Norris @ 2015-12-06 14:52 UTC (permalink / raw)
  To: GCC Patches; +Cc: fortran, Thomas Schwinge

[-- Attachment #1: Type: text/plain, Size: 291 bytes --]

Hi,

This patch fixes a some runtime issues when dealing with
the deviceptr clause in Fortran. There were some corner
cases that were not being dealt with correctly, and the
patch resolves these. Also a new set of test cases has
been added.

I've applied this patch to gomp-4_0-branch.

Jim

[-- Attachment #2: deviceptr.patch --]
[-- Type: text/x-patch, Size: 8722 bytes --]

diff --git a/libgomp/ChangeLog.gomp b/libgomp/ChangeLog.gomp
index a2f1c31..791aa4c 100644
--- a/libgomp/ChangeLog.gomp
+++ b/libgomp/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2015-12-06  James Norris  <jnorris@codesourcery.com>
+
+	* oacc-parallel.c (GOACC_parallel_keyed, GOACC_data_start):
+	Handle Fortran deviceptr clause combination.
+	* testsuite/libgomp.oacc-fortran/deviceptr-1.f90: New test.
+	* testsuite/libgomp.oacc-fortran/declare-1.f90: Remove erroneous test.
+
 2015-12-05  Chung-Lin Tang  <cltang@codesourcery.com>
 
 	* oacc-plugin.h (GOMP_PLUGIN_async_unmap_vars): Add int parameter.
diff --git a/libgomp/oacc-parallel.c b/libgomp/oacc-parallel.c
index a4b2c01..a606152 100644
--- a/libgomp/oacc-parallel.c
+++ b/libgomp/oacc-parallel.c
@@ -99,18 +99,37 @@ GOACC_parallel_keyed (int device, void (*fn) (void *),
   thr = goacc_thread ();
   acc_dev = thr->dev;
 
-  for (i = 0; i < (signed)(mapnum - 1); i++)
+  for (i = 0; i < mapnum; i++)
     {
       unsigned short kind1 = kinds[i] & 0xff;
-      unsigned short kind2 = kinds[i+1] & 0xff;
 
       /* Handle Fortran deviceptr clause.  */
-      if ((kind1 == GOMP_MAP_FORCE_DEVICEPTR && kind2 == GOMP_MAP_POINTER)
-	   && (sizes[i + 1] == 0)
-	   && (hostaddrs[i] == *(void **)hostaddrs[i + 1]))
+      if (kind1 == GOMP_MAP_FORCE_DEVICEPTR)
 	{
-	  kinds[i+1] = kinds[i];
-	  sizes[i+1] = sizeof (void *);
+	  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;
 	}
     }
@@ -254,18 +273,38 @@ GOACC_data_start (int device, size_t mapnum,
   struct goacc_thread *thr = goacc_thread ();
   struct gomp_device_descr *acc_dev = thr->dev;
 
-  for (i = 0; i < (signed)(mapnum - 1); i++)
+  for (i = 0; i < mapnum; i++)
     {
       unsigned short kind1 = kinds[i] & 0xff;
-      unsigned short kind2 = kinds[i+1] & 0xff;
 
       /* Handle Fortran deviceptr clause.  */
-      if ((kind1 == GOMP_MAP_FORCE_DEVICEPTR && kind2 == GOMP_MAP_POINTER)
-	   && (sizes[i + 1] == 0)
-	   && (hostaddrs[i] == *(void **)hostaddrs[i + 1]))
+      if (kind1 == GOMP_MAP_FORCE_DEVICEPTR)
 	{
-	  kinds[i+1] = kinds[i];
-	  sizes[i+1] = sizeof (void *);
+	  unsigned short kind2;
+
+	  if (i < (signed)mapnum - 1)
+	    kind2 = kinds[i + 1] & 0xff;
+	  else
+	    kind2 = 0xffff;
+
+	  /* If the size is right, skip it.  */
+	  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;
 	}
     }
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
index 430cd24..e781878 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
@@ -1,6 +1,4 @@
 ! { dg-do run  { target openacc_nvidia_accel_selected } }
-! libgomp: cuStreamSynchronize error: an illegal memory access was encountered
-! { dg-xfail-run-if "TODO" { *-*-* } }
 
 module vars
   implicit none
@@ -8,24 +6,6 @@ module vars
   !$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
@@ -203,15 +183,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
@@ -243,8 +214,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..879cbf1
--- /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] 5+ messages in thread

* Re: [gomp4] Fix Fortran deviceptr
  2015-12-06 14:52 [gomp4] Fix Fortran deviceptr James Norris
@ 2015-12-07 15:55 ` Cesar Philippidis
  2015-12-08 16:22   ` James Norris
  0 siblings, 1 reply; 5+ messages in thread
From: Cesar Philippidis @ 2015-12-07 15:55 UTC (permalink / raw)
  To: James Norris, GCC Patches; +Cc: fortran, Thomas Schwinge

On 12/06/2015 06:52 AM, James Norris wrote:

> This patch fixes a some runtime issues when dealing with
> the deviceptr clause in Fortran. There were some corner
> cases that were not being dealt with correctly, and the
> patch resolves these. Also a new set of test cases has
> been added.

Which corner cases?

> diff --git a/libgomp/ChangeLog.gomp b/libgomp/ChangeLog.gomp
> index a2f1c31..791aa4c 100644
> --- a/libgomp/ChangeLog.gomp
> +++ b/libgomp/ChangeLog.gomp
> @@ -1,3 +1,10 @@
> +2015-12-06  James Norris  <jnorris@codesourcery.com>
> +
> +	* oacc-parallel.c (GOACC_parallel_keyed, GOACC_data_start):
> +	Handle Fortran deviceptr clause combination.
> +	* testsuite/libgomp.oacc-fortran/deviceptr-1.f90: New test.
> +	* testsuite/libgomp.oacc-fortran/declare-1.f90: Remove erroneous test.
> +
>  2015-12-05  Chung-Lin Tang  <cltang@codesourcery.com>
>  
>  	* oacc-plugin.h (GOMP_PLUGIN_async_unmap_vars): Add int parameter.
> diff --git a/libgomp/oacc-parallel.c b/libgomp/oacc-parallel.c
> index a4b2c01..a606152 100644
> --- a/libgomp/oacc-parallel.c
> +++ b/libgomp/oacc-parallel.c
> @@ -99,18 +99,37 @@ GOACC_parallel_keyed (int device, void (*fn) (void *),
>    thr = goacc_thread ();
>    acc_dev = thr->dev;
>  
> -  for (i = 0; i < (signed)(mapnum - 1); i++)
> +  for (i = 0; i < mapnum; i++)
>      {
>        unsigned short kind1 = kinds[i] & 0xff;
> -      unsigned short kind2 = kinds[i+1] & 0xff;
>  
>        /* Handle Fortran deviceptr clause.  */
> -      if ((kind1 == GOMP_MAP_FORCE_DEVICEPTR && kind2 == GOMP_MAP_POINTER)
> -	   && (sizes[i + 1] == 0)
> -	   && (hostaddrs[i] == *(void **)hostaddrs[i + 1]))
> +      if (kind1 == GOMP_MAP_FORCE_DEVICEPTR)
>  	{
> -	  kinds[i+1] = kinds[i];
> -	  sizes[i+1] = sizeof (void *);
> +	  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;
>  	}
>      }
> @@ -254,18 +273,38 @@ GOACC_data_start (int device, size_t mapnum,
>    struct goacc_thread *thr = goacc_thread ();
>    struct gomp_device_descr *acc_dev = thr->dev;
>  
> -  for (i = 0; i < (signed)(mapnum - 1); i++)
> +  for (i = 0; i < mapnum; i++)
>      {
>        unsigned short kind1 = kinds[i] & 0xff;
> -      unsigned short kind2 = kinds[i+1] & 0xff;
>  
>        /* Handle Fortran deviceptr clause.  */
> -      if ((kind1 == GOMP_MAP_FORCE_DEVICEPTR && kind2 == GOMP_MAP_POINTER)
> -	   && (sizes[i + 1] == 0)
> -	   && (hostaddrs[i] == *(void **)hostaddrs[i + 1]))
> +      if (kind1 == GOMP_MAP_FORCE_DEVICEPTR)
>  	{
> -	  kinds[i+1] = kinds[i];
> -	  sizes[i+1] = sizeof (void *);
> +	  unsigned short kind2;
> +
> +	  if (i < (signed)mapnum - 1)
> +	    kind2 = kinds[i + 1] & 0xff;
> +	  else
> +	    kind2 = 0xffff;
> +
> +	  /* If the size is right, skip it.  */
> +	  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;
>  	}
>      }

Two observations:

 1. Why is deviceptr so special that gomp_map_vars can't handle it
    directly?

 2. It appears that deviceptr code in GOACC_parallel_keyed is mostly
    identical to GOACC_data_start. Can you put that duplicate code into
    a function? That would be easier to maintain in the long run.

> diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
> index 430cd24..e781878 100644
> --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
> @@ -1,6 +1,4 @@
>  ! { dg-do run  { target openacc_nvidia_accel_selected } }
> -! libgomp: cuStreamSynchronize error: an illegal memory access was encountered
> -! { dg-xfail-run-if "TODO" { *-*-* } }

Maybe add a comment to describe what the test is doing like you did ...

> 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..879cbf1
> --- /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.

... here. And minor nit, but the other fortran tests only use a single
exclamation point for comments. This test should also use a single one
for consistency.

Cesar

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [gomp4] Fix Fortran deviceptr
  2015-12-07 15:55 ` Cesar Philippidis
@ 2015-12-08 16:22   ` James Norris
  2015-12-08 17:11     ` Cesar Philippidis
  0 siblings, 1 reply; 5+ messages in thread
From: James Norris @ 2015-12-08 16:22 UTC (permalink / raw)
  To: Cesar Philippidis, GCC Patches; +Cc: fortran, Thomas Schwinge

Cesar,

On 12/07/2015 09:55 AM, Cesar Philippidis wrote:

> [snip snip]
> Two observations:
>
>   1. Why is deviceptr so special that gomp_map_vars can't handle it
>      directly?

Recall that the deviceptr clause in Fortran presents as two
mappings: FORCE_DEVICEPTR and POINTER. The former
has the device address in hostaddr, while the latter has the
host address of the pointer in hostaddr. The new code
detects a properly formed pair and if found, proceeds to
turn the latter into the FORCE_DEVICEPTR map, while the
former is effectively discarded by setting hostaddr to NULL.

This behavior is specific to OpenACC, so I decided put it where
I did. Could it be put into gomp_map_vars? Probably. Would it
be messy? Probably. But what may be a better solution would
be to use the functionality that handles the use_device_ptr
clause in OpenMP4.1 and eliminate FORCE_DEVICEPTR from
gomp_map_var. Have to look into that.


>
>   2. It appears that deviceptr code in GOACC_parallel_keyed is mostly
>      identical to GOACC_data_start. Can you put that duplicate code into
>      a function? That would be easier to maintain in the long run.
>

Fixed.

Thanks,
Jim


^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [gomp4] Fix Fortran deviceptr
  2015-12-08 16:22   ` James Norris
@ 2015-12-08 17:11     ` Cesar Philippidis
  2015-12-09 16:34       ` James Norris
  0 siblings, 1 reply; 5+ messages in thread
From: Cesar Philippidis @ 2015-12-08 17:11 UTC (permalink / raw)
  To: James Norris, GCC Patches; +Cc: fortran, Thomas Schwinge

On 12/08/2015 08:22 AM, James Norris wrote:

>>   2. It appears that deviceptr code in GOACC_parallel_keyed is mostly
>>      identical to GOACC_data_start. Can you put that duplicate code into
>>      a function? That would be easier to maintain in the long run.
>>
> 
> Fixed.

Where? I don't see a patch.

Since you're working on fortran, can you take a look at how
gfc_match_omp_clauses is handling OMP_CLAUSE_DEVICEPTR. It seems overly
confusing to me. Could it be done in a similar way as OMP_CLAUSE_COPYIN,
i.e., using gfc_match_omp_map_clause?

Cesar

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [gomp4] Fix Fortran deviceptr
  2015-12-08 17:11     ` Cesar Philippidis
@ 2015-12-09 16:34       ` James Norris
  0 siblings, 0 replies; 5+ messages in thread
From: James Norris @ 2015-12-09 16:34 UTC (permalink / raw)
  To: Cesar Philippidis, GCC Patches; +Cc: fortran, Thomas Schwinge

[-- Attachment #1: Type: text/plain, Size: 811 bytes --]

Cesar,

On 12/08/2015 11:10 AM, Cesar Philippidis wrote:
> On 12/08/2015 08:22 AM, James Norris wrote:
>
>>>    2. It appears that deviceptr code in GOACC_parallel_keyed is mostly
>>>       identical to GOACC_data_start. Can you put that duplicate code into
>>>       a function? That would be easier to maintain in the long run.
>>>
>>
>> Fixed.
>
> Where? I don't see a patch.

Oppssss... Now attached.


>
> Since you're working on fortran, can you take a look at how
> gfc_match_omp_clauses is handling OMP_CLAUSE_DEVICEPTR. It seems overly
> confusing to me. Could it be done in a similar way as OMP_CLAUSE_COPYIN,
> i.e., using gfc_match_omp_map_clause?
>

Confusion removed and replaced with code similar to how
the other clauses are handled.

Patch to be committed after testing completes.

Thanks!
Jim

[-- Attachment #2: deviceptr.patch --]
[-- Type: text/x-patch, Size: 7625 bytes --]

diff --git a/gcc/fortran/ChangeLog.gomp b/gcc/fortran/ChangeLog.gomp
index 00e5746..d05326d 100644
--- a/gcc/fortran/ChangeLog.gomp
+++ b/gcc/fortran/ChangeLog.gomp
@@ -1,3 +1,8 @@
+2015-12-09  James Norris  <jnorris@codesourcery.com>
+
+	* openmp.c (gfc_match_omp_clauses): Re-write handling of the
+	deviceptr clause.
+
 2015-12-08  Thomas Schwinge  <thomas@codesourcery.com>
 
 	* gfortran.h (symbol_attribute): Add oacc_function_nohost member.
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index b59528be..78d2e1e 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -818,19 +818,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_BIND) && c->routine_bind == NULL
 	  && gfc_match ("bind ( %s )", &c->routine_bind) == MATCH_YES)
 	{
diff --git a/libgomp/ChangeLog.gomp b/libgomp/ChangeLog.gomp
index d88cb94..ec133a7 100644
--- a/libgomp/ChangeLog.gomp
+++ b/libgomp/ChangeLog.gomp
@@ -1,3 +1,11 @@
+2015-12-09  James Norris  <jnorris@codesourcery.com>
+
+	* oacc-parallel.c (handle_ftn_pointers): New function.
+	(GOACC_parallel_keyed, GOACC_data_start): Factor out Fortran pointer
+	handling.
+	* testsuite/libgomp.oacc-fortran/declare-1.f90: Add comment.
+	* testsuite/libgomp.oacc-fortran/deviceptr-1.f90: Fix comment.
+
 2015-12-08  James Norris  <jnorris@codesourcery.com>
 
 	* testsuite/libgomp.oacc-fortran/kernels-map-1.f90: Add new test.
diff --git a/libgomp/oacc-parallel.c b/libgomp/oacc-parallel.c
index a606152..f68db78 100644
--- a/libgomp/oacc-parallel.c
+++ b/libgomp/oacc-parallel.c
@@ -57,6 +57,51 @@ find_pointer (int pos, size_t mapnum, unsigned short *kinds)
   return 0;
 }
 
+/* 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);
 
 
@@ -99,40 +144,7 @@ GOACC_parallel_keyed (int device, void (*fn) (void *),
   thr = goacc_thread ();
   acc_dev = thr->dev;
 
-  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;
-	}
-    }
+  handle_ftn_pointers (mapnum, hostaddrs, sizes, kinds);
 
   /* Host fallback if "if" clause is false or if the current device is set to
      the host.  */
@@ -258,7 +270,6 @@ GOACC_data_start (int device, size_t mapnum,
 {
   bool host_fallback = device == GOMP_DEVICE_HOST_FALLBACK;
   struct target_mem_desc *tgt;
-  int i;
 
 #ifdef HAVE_INTTYPES_H
   gomp_debug (0, "%s: mapnum=%"PRIu64", hostaddrs=%p, sizes=%p, kinds=%p\n",
@@ -273,41 +284,7 @@ GOACC_data_start (int device, size_t mapnum,
   struct goacc_thread *thr = goacc_thread ();
   struct gomp_device_descr *acc_dev = thr->dev;
 
-  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 the size is right, skip it.  */
-	  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;
-	}
-    }
+  handle_ftn_pointers (mapnum, hostaddrs, sizes, kinds);
 
   /* Host fallback or 'do nothing'.  */
   if ((acc_dev->capabilities & GOMP_OFFLOAD_CAP_SHARED_MEM)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
index e781878..2d4b707 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
@@ -1,5 +1,16 @@
 ! { 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
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90
index 879cbf1..276a172 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90
@@ -1,8 +1,8 @@
 ! { dg-do run }
 
-!! Test the deviceptr clause with various directives
-!! and in combination with other directives where
-!! the deviceptr variable is implied.
+! 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

^ permalink raw reply	[flat|nested] 5+ messages in thread

end of thread, other threads:[~2015-12-09 16:34 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-12-06 14:52 [gomp4] Fix Fortran deviceptr James Norris
2015-12-07 15:55 ` Cesar Philippidis
2015-12-08 16:22   ` James Norris
2015-12-08 17:11     ` Cesar Philippidis
2015-12-09 16:34       ` 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).