2016-07-01 Cesar Philippidis 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