Commit ef4add8e by Tobias Burnus Committed by Tobias Burnus

Support OpenMP's use_device_addr in Fortran

        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
parent fc1a202c
2019-10-02 Tobias Burnus <tobias@codesourcery.com> 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 * openmp.c (gfc_match_omp_clauses): Show a clause-parsing
error if none was rised before. error if none was rised before.
* parse.c (matcha, matcho): If error occurred after * parse.c (matcha, matcho): If error occurred after
......
...@@ -1507,6 +1507,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) ...@@ -1507,6 +1507,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_CACHE: type = "CACHE"; break; case OMP_LIST_CACHE: type = "CACHE"; break;
case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; 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_PTR: type = "USE_DEVICE_PTR"; break;
case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
default: default:
gcc_unreachable (); gcc_unreachable ();
} }
......
...@@ -1263,6 +1263,7 @@ enum ...@@ -1263,6 +1263,7 @@ enum
OMP_LIST_CACHE, OMP_LIST_CACHE,
OMP_LIST_IS_DEVICE_PTR, OMP_LIST_IS_DEVICE_PTR,
OMP_LIST_USE_DEVICE_PTR, OMP_LIST_USE_DEVICE_PTR,
OMP_LIST_USE_DEVICE_ADDR,
OMP_LIST_NUM OMP_LIST_NUM
}; };
......
...@@ -780,6 +780,7 @@ enum omp_mask1 ...@@ -780,6 +780,7 @@ enum omp_mask1
OMP_CLAUSE_SIMD, OMP_CLAUSE_SIMD,
OMP_CLAUSE_THREADS, OMP_CLAUSE_THREADS,
OMP_CLAUSE_USE_DEVICE_PTR, OMP_CLAUSE_USE_DEVICE_PTR,
OMP_CLAUSE_USE_DEVICE_ADDR, /* Actually, OpenMP 5.0. */
OMP_CLAUSE_NOWAIT, OMP_CLAUSE_NOWAIT,
/* This must come last. */ /* This must come last. */
OMP_MASK1_LAST OMP_MASK1_LAST
...@@ -1849,6 +1850,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, ...@@ -1849,6 +1850,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
("use_device_ptr (", ("use_device_ptr (",
&c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES) &c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES)
continue; 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; break;
case 'v': case 'v':
/* VECTOR_LENGTH must be matched before VECTOR, because the latter /* VECTOR_LENGTH must be matched before VECTOR, because the latter
...@@ -2479,7 +2485,7 @@ cleanup: ...@@ -2479,7 +2485,7 @@ cleanup:
| OMP_CLAUSE_IS_DEVICE_PTR) | OMP_CLAUSE_IS_DEVICE_PTR)
#define OMP_TARGET_DATA_CLAUSES \ #define OMP_TARGET_DATA_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ (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 \ #define OMP_TARGET_ENTER_DATA_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
| OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT) | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
...@@ -4008,7 +4014,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, ...@@ -4008,7 +4014,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
"TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "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) if (omp_clauses == NULL)
return; return;
...@@ -4565,8 +4571,26 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, ...@@ -4565,8 +4571,26 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
} }
break; break;
case OMP_LIST_IS_DEVICE_PTR: 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: case OMP_LIST_USE_DEVICE_PTR:
/* FIXME: Handle these. */ case OMP_LIST_USE_DEVICE_ADDR:
/* FIXME: Handle OMP_LIST_USE_DEVICE_PTR. */
break; break;
default: default:
for (; n != NULL; n = n->next) for (; n != NULL; n = n->next)
......
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> 2019-10-02 Richard Biener <rguenther@suse.de>
PR c++/91606 PR c++/91606
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment