2016-07-27 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/ * lto-cgraph.c (input_overwrite_node): Change the assertion to an error for missing symbols. 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: * testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f: Add test coverage. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 2327b13..7784e93 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -292,6 +292,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. */ @@ -301,6 +310,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. */ @@ -851,7 +861,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; unsigned oacc_function_nohost:1; /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 32ee526..6ee81c3 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 52c0309..c20a0a3 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1879,21 +1879,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); @@ -1901,10 +1911,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 @@ -1915,6 +1922,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; @@ -1932,12 +1940,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; @@ -1945,7 +1955,7 @@ gfc_match_oacc_routine (void) sym = NULL; } - if (st == NULL + if ((st == NULL && isym == NULL) || (sym && !sym->attr.external && !sym->attr.function @@ -1981,7 +1991,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; @@ -1999,7 +2012,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); gfc_current_ns->proc_name->attr.oacc_function_nohost = c ? c->nohost : false; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 8efd12c..3ef3276 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -86,6 +86,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 1feee82..5271268 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) NULL_TREE, list); #endif - 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/lto-cgraph.c b/gcc/lto-cgraph.c index 60e73d6..857ce4d 100644 --- a/gcc/lto-cgraph.c +++ b/gcc/lto-cgraph.c @@ -1201,15 +1201,8 @@ input_overwrite_node (struct lto_file_decl_data *file_data, int success = flag_ltrans || (!node->in_other_partition && !node->used_from_other_partition); - if (!success) - { - gcc_assert (flag_openacc); - if (TREE_CODE (node->decl) == FUNCTION_DECL) - error ("missing OpenACC % function %qD", node->decl); - else - error ("missing OpenACC % variable %qD", node->decl); - } + error ("Missing %<%s%>", node->name ()); } /* Return string alias is alias of. */ 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..c48269b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90 @@ -0,0 +1,70 @@ +! Test acc routines inside modules. + +! { dg-additional-options "-O0" } + +module routines + integer a +contains + subroutine vector ! { dg-warning "partitioned but does not contain" } + implicit none + !$acc routine vector + end subroutine vector + + subroutine worker ! { dg-warning "partitioned but does not contain" } + implicit none + !$acc routine worker + end subroutine worker + + subroutine gang ! { dg-warning "partitioned but does not contain" } + 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.