This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] OpenACC routines in fortran modules
- From: Cesar Philippidis <cesar at codesourcery dot com>
- To: "gcc-patches at gcc dot gnu dot org" <gcc-patches at gcc dot gnu dot org>, Fortran List <fortran at gcc dot gnu dot org>, Jakub Jelinek <jakub at redhat dot com>
- Date: Fri, 1 Jul 2016 13:40:58 -0700
- Subject: [PATCH] OpenACC routines in fortran modules
- Authentication-results: sourceware.org; auth=none
It turns out that the acc routine parallelism isn't being recorded in
fortran .mod files. This is a problem because then the ME can't validate
if a routine has compatible parallelism with the call site. This patch
does two things:
1. Encode gang, worker, vector and seq level parallelism in module
files. This introduces a new oacc_function enum, which I ended
up using to record the parallelism of standalone acc routines too.
2. Extends gfc_match_oacc_routine to add acc routine directive support
for intrinsic procedures such as abort.
Is this patch OK for trunk? I included support for intrinsic procedures
because it was necessary with my previous patch which treated all calls
to non-acc routines from within an OpenACC offloaded region as errors.
Now that it has been determined that those patches should be link time
errors, we technically don't need to add acc routine support for
intrinsic procedures. So I can drop that part of the patch if necessary.
Cesar
2016-07-01 Cesar Philippidis <cesar@codesourcery.com>
gcc/fortran/
* gfortran.h (enum oacc_function): Define.
(oacc_function_type): Declare.
(symbol_attribute): Change the type of oacc_function from unsigned
to an ENUM_BITFIELD.
* module.c (oacc_function): New DECL_MIO_NAME.
(mio_symbol_attribute): Set the oacc_function attribute.
* openmp.c (gfc_oacc_routine_dims): Change the return type from
int to oacc_function.
(gfc_match_oacc_routine): Handle intrinsic procedures.
* symbol.c (oacc_function_types): Define.
* trans-decl.c (add_attributes_to_decl): Update to handle the
retyped oacc_function attribute.
gcc/testsuite/
* gfortran.dg/goacc/fixed-1.f: Add test coverage.
* gfortran.dg/goacc/routine-7.f90: New test.
libgomp/
* testsuite/libgomp.oacc-fortran/abort-1.f90: Test acc routine
on intrinsic abort.
* testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f: Likewise.
* testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0bb71cb..fac94ca 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -303,6 +303,15 @@ enum save_state
{ SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
};
+/* Flags to keep track of ACC routine states. */
+enum oacc_function
+{ OACC_FUNCTION_NONE = 0,
+ OACC_FUNCTION_SEQ,
+ OACC_FUNCTION_GANG,
+ OACC_FUNCTION_WORKER,
+ OACC_FUNCTION_VECTOR
+};
+
/* Strings for all symbol attributes. We use these for dumping the
parse tree, in error messages, and also when reading and writing
modules. In symbol.c. */
@@ -312,6 +321,7 @@ extern const mstring intents[];
extern const mstring access_types[];
extern const mstring ifsrc_types[];
extern const mstring save_status[];
+extern const mstring oacc_function_types[];
/* Enumeration of all the generic intrinsic functions. Used by the
backend for identification of a function. */
@@ -862,7 +872,7 @@ typedef struct
unsigned oacc_declare_link:1;
/* This is an OpenACC acclerator function at level N - 1 */
- unsigned oacc_function:3;
+ ENUM_BITFIELD (oacc_function) oacc_function:3;
/* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
unsigned ext_attr:EXT_ATTR_NUM;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 4d664f0..267858f 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2095,6 +2095,7 @@ DECL_MIO_NAME (procedure_type)
DECL_MIO_NAME (ref_type)
DECL_MIO_NAME (sym_flavor)
DECL_MIO_NAME (sym_intent)
+DECL_MIO_NAME (oacc_function)
#undef DECL_MIO_NAME
/* Symbol attributes are stored in list with the first three elements
@@ -2116,6 +2117,8 @@ mio_symbol_attribute (symbol_attribute *attr)
attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures);
attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types);
attr->save = MIO_NAME (save_state) (attr->save, save_status);
+ attr->oacc_function = MIO_NAME (oacc_function) (attr->oacc_function,
+ oacc_function_types);
ext_attr = attr->ext_attr;
mio_integer ((int *) &ext_attr);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 865e0d9..10b880c 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1714,21 +1714,31 @@ gfc_match_oacc_cache (void)
/* Determine the loop level for a routine. */
-static int
+static oacc_function
gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
{
int level = -1;
+ oacc_function ret = OACC_FUNCTION_SEQ;
if (clauses)
{
unsigned mask = 0;
if (clauses->gang)
- level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_GANG;
+ }
if (clauses->worker)
- level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_WORKER;
+ }
if (clauses->vector)
- level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_VECTOR;
+ }
if (clauses->seq)
level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
@@ -1736,10 +1746,7 @@ gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
gfc_error ("Multiple loop axes specified for routine");
}
- if (level < 0)
- level = GOMP_DIM_MAX;
-
- return level;
+ return ret;
}
match
@@ -1750,6 +1757,7 @@ gfc_match_oacc_routine (void)
match m;
gfc_omp_clauses *c = NULL;
gfc_oacc_routine_name *n = NULL;
+ gfc_intrinsic_sym *isym = NULL;
old_loc = gfc_current_locus;
@@ -1767,12 +1775,14 @@ gfc_match_oacc_routine (void)
if (m == MATCH_YES)
{
char buffer[GFC_MAX_SYMBOL_LEN + 1];
- gfc_symtree *st;
+ gfc_symtree *st = NULL;
m = gfc_match_name (buffer);
if (m == MATCH_YES)
{
- st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
+ if ((isym = gfc_find_function (buffer)) == NULL
+ && (isym = gfc_find_subroutine (buffer)) == NULL)
+ st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
if (st)
{
sym = st->n.sym;
@@ -1780,7 +1790,7 @@ gfc_match_oacc_routine (void)
sym = NULL;
}
- if (st == NULL
+ if ((st == NULL && isym == NULL)
|| (sym
&& !sym->attr.external
&& !sym->attr.function
@@ -1814,7 +1824,10 @@ gfc_match_oacc_routine (void)
!= MATCH_YES))
return MATCH_ERROR;
- if (sym != NULL)
+ if (isym != NULL)
+ /* There is nothing to do for intrinsic procedures. */
+ ;
+ else if (sym != NULL)
{
n = gfc_get_oacc_routine_name ();
n->sym = sym;
@@ -1832,7 +1845,7 @@ gfc_match_oacc_routine (void)
&old_loc))
goto cleanup;
gfc_current_ns->proc_name->attr.oacc_function
- = gfc_oacc_routine_dims (c) + 1;
+ = gfc_oacc_routine_dims (c);
}
if (n)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 0ee7dec..b1dd32b 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -87,6 +87,15 @@ const mstring save_status[] =
minit ("IMPLICIT-SAVE", SAVE_IMPLICIT),
};
+const mstring oacc_function_types[] =
+{
+ minit ("NONE", OACC_FUNCTION_NONE),
+ minit ("OACC_FUNCTION_SEQ", OACC_FUNCTION_SEQ),
+ minit ("OACC_FUNCTION_GANG", OACC_FUNCTION_GANG),
+ minit ("OACC_FUNCTION_WORKER", OACC_FUNCTION_WORKER),
+ minit ("OACC_FUNCTION_VECTOR", OACC_FUNCTION_VECTOR)
+};
+
/* This is to make sure the backend generates setup code in the correct
order. */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 2f5e434..04f9860 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1327,11 +1327,26 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
list = tree_cons (get_identifier ("omp declare target"),
NULL_TREE, list);
- if (sym_attr.oacc_function)
+ if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
{
tree dims = NULL_TREE;
int ix;
- int level = sym_attr.oacc_function - 1;
+ int level = GOMP_DIM_MAX;
+
+ switch (sym_attr.oacc_function)
+ {
+ case OACC_FUNCTION_GANG:
+ level = GOMP_DIM_GANG;
+ break;
+ case OACC_FUNCTION_WORKER:
+ level = GOMP_DIM_WORKER;
+ break;
+ case OACC_FUNCTION_VECTOR:
+ level = GOMP_DIM_VECTOR;
+ break;
+ case OACC_FUNCTION_SEQ:
+ default:;
+ }
for (ix = GOMP_DIM_MAX; ix--;)
dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
diff --git a/gcc/testsuite/gfortran.dg/goacc/fixed-1.f b/gcc/testsuite/gfortran.dg/goacc/fixed-1.f
index 6a454190..0c0fb98 100644
--- a/gcc/testsuite/gfortran.dg/goacc/fixed-1.f
+++ b/gcc/testsuite/gfortran.dg/goacc/fixed-1.f
@@ -1,3 +1,5 @@
+!$ACC ROUTINE(ABORT) SEQ
+
INTEGER :: ARGC
ARGC = COMMAND_ARGUMENT_COUNT ()
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-7.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90
new file mode 100644
index 0000000..e1e0ab7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90
@@ -0,0 +1,69 @@
+! Test acc routines inside modules.
+
+! { dg-additional-options "-O0" }
+
+module routines
+contains
+ subroutine vector
+ implicit none
+ !$acc routine vector
+ end subroutine vector
+
+ subroutine worker
+ implicit none
+ !$acc routine worker
+ end subroutine worker
+
+ subroutine gang
+ implicit none
+ !$acc routine gang
+ end subroutine gang
+
+ subroutine seq
+ implicit none
+ !$acc routine seq
+ end subroutine seq
+end module routines
+
+program main
+ use routines
+ implicit none
+
+ integer :: i
+
+ !$acc parallel loop gang
+ do i = 1, 10
+ call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+ call worker
+ call vector
+ call seq
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, 10
+ call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+ call worker ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+ call vector
+ call seq
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, 10
+ call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+ call worker ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+ call vector ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+ call seq
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, 10
+ call gang
+ call worker
+ call vector
+ call seq
+ end do
+ !$acc end parallel loop
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
index b38303d..48ebc38 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
@@ -1,5 +1,6 @@
program main
implicit none
+ !$acc routine(abort) seq
print *, "CheCKpOInT"
!$acc parallel
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
index a19045b..cbd1dd9 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
@@ -6,6 +6,7 @@
USE OPENACC
IMPLICIT NONE
+!$ACC ROUTINE(ABORT) SEQ
!Host.
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
index 200188e..07cd6d9 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
@@ -1,121 +1,95 @@
+! Test acc routines inside modules.
! { dg-do run }
-! { dg-additional-options "-cpp" }
-#define M 8
-#define N 32
+module routines
+ integer, parameter :: N = 32
-program main
- integer :: i
- integer :: a(N)
- integer :: b(M * N)
-
- do i = 1, N
- a(i) = 0
- end do
+contains
+ subroutine vector (a)
+ implicit none
+ !$acc routine vector
+ integer, intent (inout) :: a(N)
+ integer :: i
- !$acc parallel copy (a)
- !$acc loop seq
+ !$acc loop vector
do i = 1, N
- call seq (a)
+ a(i) = 1
end do
- !$acc end parallel
+ end subroutine vector
- do i = 1, N
- if (a(i) .ne.N) call abort
- end do
+ subroutine worker (a)
+ implicit none
+ !$acc routine worker
+ integer, intent (inout) :: a(N)
+ integer :: i
- !$acc parallel copy (a)
- !$acc loop seq
- do i = 1, N
- call gang (a)
+ !$acc loop worker
+ do i = 1, N
+ a(i) = 2
end do
- !$acc end parallel
-
- do i = 1, N
- if (a(i) .ne. (N + (N * (-1 * i)))) call abort
- end do
+ end subroutine worker
- do i = 1, N
- b(i) = i
- end do
+ subroutine gang (a)
+ implicit none
+ !$acc routine gang
+ integer, intent (inout) :: a(N)
+ integer :: i
- !$acc parallel copy (b)
- !$acc loop seq
+ !$acc loop gang
do i = 1, N
- call worker (b)
+ a(i) = 3
end do
- !$acc end parallel
+ end subroutine gang
- do i = 1, N
- if (b(i) .ne. N + i) call abort
- end do
+ subroutine seq (a)
+ implicit none
+ !$acc routine seq
+ integer, intent (inout) :: a(N)
+ integer :: i
- do i = 1, N
- a(i) = i
- end do
-
- !$acc parallel copy (a)
- !$acc loop seq
do i = 1, N
- call vector (a)
+ a(i) = 4
end do
- !$acc end parallel
-
- do i = 1, N
- if (a(i) .ne. 0) call abort
- end do
+ end subroutine seq
+end module routines
-contains
+program main
+ use routines
+ implicit none
-subroutine vector (a)
- !$acc routine vector
- integer, intent (inout) :: a(N)
integer :: i
+ integer :: a(N)
+
+ !$acc parallel
+ call seq (a)
+ !$acc end parallel
- !$acc loop vector
do i = 1, N
- a(i) = a(i) - a(i)
+ if (a(i) .ne. 4) call abort
end do
-end subroutine vector
-
-subroutine worker (b)
- !$acc routine worker
- integer, intent (inout) :: b(M*N)
- integer :: i, j
+ !$acc parallel
+ call gang (a)
+ !$acc end parallel
- !$acc loop worker
do i = 1, N
- !$acc loop vector
- do j = 1, M
- b(j + ((i - 1) * M)) = b(j + ((i - 1) * M)) + 1
- end do
+ if (a(i) .ne. 3) call abort
end do
-end subroutine worker
-
-subroutine gang (a)
- !$acc routine gang
- integer, intent (inout) :: a(N)
- integer :: i
+ !$acc parallel
+ call worker (a)
+ !$acc end parallel
- !$acc loop gang
do i = 1, N
- a(i) = a(i) - i
+ if (a(i) .ne. 2) call abort
end do
-end subroutine gang
-
-subroutine seq (a)
- !$acc routine seq
- integer, intent (inout) :: a(M)
- integer :: i
+ !$acc parallel
+ call vector (a)
+ !$acc end parallel
do i = 1, N
- a(i) = a(i) + 1
+ if (a(i) .ne. 1) call abort
end do
-
-end subroutine seq
-
end program main