Support OpenMP's use_device_addr in Fortran
authorTobias Burnus <tobias@codesourcery.com>
Wed, 2 Oct 2019 10:57:54 +0000 (10:57 +0000)
committerTobias Burnus <burnus@gcc.gnu.org>
Wed, 2 Oct 2019 10:57:54 +0000 (12:57 +0200)
        gcc/fortran/
* dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_USE_DEVICE_ADDR.
* gfortran.h (enum): Add OMP_LIST_USE_DEVICE_ADDR.
* openmp.c (omp_mask1): Likewise.
(gfc_match_omp_clauses): Match 'use_device_addr'.
(OMP_TARGET_DATA_CLAUSES): Add OMP_LIST_USE_DEVICE_ADDR.
(resolve_omp_clauses): Add it; add is_device_ptr checks.

        gcc/testsuite/
* gfortran.dg/gomp/is_device_ptr-1.f90: New.

From-SVN: r276449

gcc/fortran/ChangeLog
gcc/fortran/dump-parse-tree.c
gcc/fortran/gfortran.h
gcc/fortran/openmp.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/gomp/is_device_ptr-1.f90 [new file with mode: 0644]

index 075f3b9df3be017d531e0a565e024afa97175ba7..8d7a2cf4c26c4468d6b940e7030dca75f3462a27 100644 (file)
@@ -1,3 +1,12 @@
+2019-10-02  Tobias Burnus  <tobias@codesourcery.com>
+
+       * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_USE_DEVICE_ADDR.
+       * gfortran.h (enum): Add OMP_LIST_USE_DEVICE_ADDR.
+       * openmp.c (omp_mask1): Likewise.
+       (gfc_match_omp_clauses): Match 'use_device_addr'.
+       (OMP_TARGET_DATA_CLAUSES): Add OMP_LIST_USE_DEVICE_ADDR.
+       (resolve_omp_clauses): Add it; add is_device_ptr checks.
+
 2019-10-02  Tobias Burnus  <tobias@codesourcery.com>
 
        * openmp.c (gfc_match_omp_clauses): Show a clause-parsing
index 513f211b68b793681ac099eac2a0b0c792f035b4..9d7b26f5f6a16ccb29e029c8e0f8a351262c6aac 100644 (file)
@@ -1507,6 +1507,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
          case OMP_LIST_CACHE: type = "CACHE"; break;
          case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break;
          case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
+         case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
          default:
            gcc_unreachable ();
          }
index 6f7717d11340a7f2aff815d69c82d7b3123eb19c..a70978bf49be43853991905f27b31857bc77f0a8 100644 (file)
@@ -1263,6 +1263,7 @@ enum
   OMP_LIST_CACHE,
   OMP_LIST_IS_DEVICE_PTR,
   OMP_LIST_USE_DEVICE_PTR,
+  OMP_LIST_USE_DEVICE_ADDR,
   OMP_LIST_NUM
 };
 
index 2beac3dc054c5f846d1eaa16e41586d62f1ec39c..7df7384c187ab5a1564eb94970993e54efca31f9 100644 (file)
@@ -780,6 +780,7 @@ enum omp_mask1
   OMP_CLAUSE_SIMD,
   OMP_CLAUSE_THREADS,
   OMP_CLAUSE_USE_DEVICE_PTR,
+  OMP_CLAUSE_USE_DEVICE_ADDR,  /* Actually, OpenMP 5.0.  */
   OMP_CLAUSE_NOWAIT,
   /* This must come last.  */
   OMP_MASK1_LAST
@@ -1849,6 +1850,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
                   ("use_device_ptr (",
                    &c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES)
            continue;
+         if ((mask & OMP_CLAUSE_USE_DEVICE_ADDR)
+             && gfc_match_omp_variable_list
+                  ("use_device_addr (",
+                   &c->lists[OMP_LIST_USE_DEVICE_ADDR], false) == MATCH_YES)
+           continue;
          break;
        case 'v':
          /* VECTOR_LENGTH must be matched before VECTOR, because the latter
@@ -2479,7 +2485,7 @@ cleanup:
    | OMP_CLAUSE_IS_DEVICE_PTR)
 #define OMP_TARGET_DATA_CLAUSES \
   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF       \
-   | OMP_CLAUSE_USE_DEVICE_PTR)
+   | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
 #define OMP_TARGET_ENTER_DATA_CLAUSES \
   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF       \
    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
@@ -4008,7 +4014,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
     = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
        "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
        "TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
-       "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR" };
+       "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR" };
 
   if (omp_clauses == NULL)
     return;
@@ -4565,8 +4571,26 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
                }
            break;
          case OMP_LIST_IS_DEVICE_PTR:
+           if (!n->sym->attr.dummy)
+             gfc_error ("Non-dummy object %qs in %s clause at %L",
+                        n->sym->name, name, &n->where);
+           if (n->sym->attr.allocatable
+               || (n->sym->ts.type == BT_CLASS
+                   && CLASS_DATA (n->sym)->attr.allocatable))
+             gfc_error ("ALLOCATABLE object %qs in %s clause at %L",
+                        n->sym->name, name, &n->where);
+           if (n->sym->attr.pointer
+               || (n->sym->ts.type == BT_CLASS
+                   && CLASS_DATA (n->sym)->attr.pointer))
+             gfc_error ("POINTER object %qs in %s clause at %L",
+                        n->sym->name, name, &n->where);
+           if (n->sym->attr.value)
+             gfc_error ("VALUE object %qs in %s clause at %L",
+                        n->sym->name, name, &n->where);
+           break;
          case OMP_LIST_USE_DEVICE_PTR:
-           /* FIXME: Handle these.  */
+         case OMP_LIST_USE_DEVICE_ADDR:
+           /* FIXME: Handle OMP_LIST_USE_DEVICE_PTR.  */
            break;
          default:
            for (; n != NULL; n = n->next)
index 3fbed65d3c16779e4685cb0e2d76d9731c40ffb0..86b8f73f895f56261d5ae2658fd105c1e6998503 100644 (file)
@@ -1,3 +1,7 @@
+2019-10-02  Tobias Burnus  <tobias@codesourcery.com>
+
+       * gfortran.dg/gomp/is_device_ptr-1.f90: New.
+
 2019-10-02  Richard Biener  <rguenther@suse.de>
 
        PR c++/91606
diff --git a/gcc/testsuite/gfortran.dg/gomp/is_device_ptr-1.f90 b/gcc/testsuite/gfortran.dg/gomp/is_device_ptr-1.f90
new file mode 100644 (file)
index 0000000..0eeca0e
--- /dev/null
@@ -0,0 +1,27 @@
+! { dg-do compile }
+subroutine test(b,c,d)
+  implicit none
+  integer, value, target :: b
+  integer, pointer :: c
+  integer, allocatable, target :: d
+
+  integer, target :: a(5)
+
+  !$omp target is_device_ptr(a) ! { dg-error "Non-dummy object .a. in IS_DEVICE_PTR clause" }
+  !$omp end target
+
+  !$omp target is_device_ptr(b) ! { dg-error "VALUE object .b. in IS_DEVICE_PTR clause" }
+  !$omp end target
+
+  !$omp target is_device_ptr(c) ! { dg-error "POINTER object .c. in IS_DEVICE_PTR clause" }
+  !$omp end target
+
+  !$omp target is_device_ptr(d) ! { dg-error "ALLOCATABLE object .d. in IS_DEVICE_PTR clause" }
+  !$omp end target
+
+  !$omp target data map(a) use_device_addr(a)  ! Should be okay
+  !$omp end target data
+
+  !$omp target data map(c) use_device_ptr(c)  ! Should be okay
+  !$omp end target data
+end subroutine test