From db941d7ef7b191700ad4467800dd0324365e474e Mon Sep 17 00:00:00 2001 From: Cesar Philippidis Date: Mon, 30 Nov 2015 11:09:33 -0800 Subject: [PATCH] tree-nested.c (convert_nonlocal_omp_clauses): Add support for OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}. gcc/ * tree-nested.c (convert_nonlocal_omp_clauses): Add support for OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}. (convert_local_omp_clauses): Likewise. gcc/fortran/ * f95-lang.c (gfc_attribute_table): Add an "oacc function" attribute. * gfortran.h (symbol_attribute): Add an oacc_function bit-field. (gfc_oacc_routine_name): New struct; (gfc_get_oacc_routine_name): New macro. (gfc_namespace): Add oacc_routine_clauses, oacc_routine_names and oacc_routine fields. (gfc_exec_op): Add EXEC_OACC_ROUTINE. * openmp.c (OACC_ROUTINE_CLAUSES): New mask. (gfc_oacc_routine_dims): New function. (gfc_match_oacc_routine): Add support for named routines and the gang, worker vector and seq clauses. * parse.c (is_oacc): Add EXEC_OACC_ROUTINE. * resolve.c (gfc_resolve_blocks): Likewise. * st.c (gfc_free_statement): Likewise. * trans-decl.c (add_attributes_to_decl): Attach an 'oacc function' attribute and shape geometry for acc routine. gcc/testsuite/ * gfortran.dg/goacc/routine-3.f90: New test. * gfortran.dg/goacc/routine-4.f90: New test. * gfortran.dg/goacc/routine-5.f90: New test. * gfortran.dg/goacc/routine-6.f90: New test. * gfortran.dg/goacc/subroutines: New test. libgomp/ * libgomp.oacc-fortran/routine-5.f90: New test. * libgomp.oacc-fortran/routine-7.f90: New test. * libgomp.oacc-fortran/routine-9.f90: New test. From-SVN: r231081 --- gcc/ChangeLog | 6 + gcc/fortran/ChangeLog | 22 +++ gcc/fortran/f95-lang.c | 2 + gcc/fortran/gfortran.h | 24 ++- gcc/fortran/openmp.c | 138 +++++++++++---- gcc/fortran/parse.c | 1 + gcc/fortran/resolve.c | 1 + gcc/fortran/st.c | 1 + gcc/fortran/trans-decl.c | 15 ++ gcc/testsuite/ChangeLog | 9 + gcc/testsuite/gfortran.dg/goacc/routine-3.f90 | 13 ++ gcc/testsuite/gfortran.dg/goacc/routine-4.f90 | 160 ++++++++++++++++++ gcc/testsuite/gfortran.dg/goacc/routine-5.f90 | 109 ++++++++++++ gcc/testsuite/gfortran.dg/goacc/routine-6.f90 | 89 ++++++++++ .../gfortran.dg/goacc/subroutines.f90 | 73 ++++++++ gcc/tree-nested.c | 60 ++++++- libgomp/ChangeLog | 8 + .../libgomp.oacc-fortran/routine-5.f90 | 27 +++ .../libgomp.oacc-fortran/routine-7.f90 | 121 +++++++++++++ .../libgomp.oacc-fortran/routine-9.f90 | 31 ++++ 20 files changed, 865 insertions(+), 45 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-3.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-4.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-5.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-6.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/subroutines.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 229aa77f89b..a1b4effd46a 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,9 @@ +2015-11-30 Cesar Philippidis + + * tree-nested.c (convert_nonlocal_omp_clauses): Add support for + OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}. + (convert_local_omp_clauses): Likewise. + 2015-11-30 Tom de Vries PR tree-optimization/46032 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c7c50647d00..52dcc826538 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2015-11-30 Cesar Philippidis + James Norris + Nathan Sidwell + + * f95-lang.c (gfc_attribute_table): Add an "oacc function" + attribute. + * gfortran.h (symbol_attribute): Add an oacc_function bit-field. + (gfc_oacc_routine_name): New struct; + (gfc_get_oacc_routine_name): New macro. + (gfc_namespace): Add oacc_routine_clauses, oacc_routine_names and + oacc_routine fields. + (gfc_exec_op): Add EXEC_OACC_ROUTINE. + * openmp.c (OACC_ROUTINE_CLAUSES): New mask. + (gfc_oacc_routine_dims): New function. + (gfc_match_oacc_routine): Add support for named routines and the + gang, worker vector and seq clauses. + * parse.c (is_oacc): Add EXEC_OACC_ROUTINE. + * resolve.c (gfc_resolve_blocks): Likewise. + * st.c (gfc_free_statement): Likewise. + * trans-decl.c (add_attributes_to_decl): Attach an 'oacc function' + attribute and shape geometry for acc routine. + 2015-11-30 Paul Thomas PR fortran/68534 diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 605c2abd01d..8556b706365 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -93,6 +93,8 @@ static const struct attribute_spec gfc_attribute_table[] = affects_type_identity } */ { "omp declare target", 0, 0, true, false, false, gfc_handle_omp_declare_target_attribute, false }, + { "oacc function", 0, -1, true, false, false, + gfc_handle_omp_declare_target_attribute, false }, { NULL, 0, 0, false, false, false, NULL, false } }; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 5487c9343e4..0628e8628c2 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -848,6 +848,9 @@ typedef struct unsigned oacc_declare_device_resident:1; unsigned oacc_declare_link:1; + /* This is an OpenACC acclerator function at level N - 1 */ + unsigned oacc_function:3; + /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; @@ -1606,6 +1609,16 @@ gfc_dt_list; /* A list of all derived types. */ extern gfc_dt_list *gfc_derived_types; +typedef struct gfc_oacc_routine_name +{ + struct gfc_symbol *sym; + struct gfc_omp_clauses *clauses; + struct gfc_oacc_routine_name *next; +} +gfc_oacc_routine_name; + +#define gfc_get_oacc_routine_name() XCNEW (gfc_oacc_routine_name) + /* A namespace describes the contents of procedure, module, interface block or BLOCK construct. */ /* ??? Anything else use these? */ @@ -1672,6 +1685,12 @@ typedef struct gfc_namespace /* !$ACC DECLARE. */ gfc_oacc_declare *oacc_declare; + /* !$ACC ROUTINE clauses. */ + gfc_omp_clauses *oacc_routine_clauses; + + /* !$ACC ROUTINE names. */ + gfc_oacc_routine_name *oacc_routine_names; + gfc_charlen *cl_list, *old_cl_list; gfc_dt_list *derived_types; @@ -1717,6 +1736,9 @@ typedef struct gfc_namespace /* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */ unsigned omp_udr_ns:1; + + /* Set to 1 for !$ACC ROUTINE namespaces. */ + unsigned oacc_routine:1; } gfc_namespace; @@ -2344,7 +2366,7 @@ enum gfc_exec_op EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END, EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH, EXEC_LOCK, EXEC_UNLOCK, - EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, + EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE, EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_ATOMIC, diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a07cee1a0b9..730b7f98cd0 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1318,6 +1318,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, | OMP_CLAUSE_DELETE) #define OACC_WAIT_CLAUSES \ (OMP_CLAUSE_ASYNC) +#define OACC_ROUTINE_CLAUSES \ + (OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ) match @@ -1619,13 +1621,44 @@ gfc_match_oacc_cache (void) return MATCH_YES; } +/* Determine the loop level for a routine. */ + +static int +gfc_oacc_routine_dims (gfc_omp_clauses *clauses) +{ + int level = -1; + + if (clauses) + { + unsigned mask = 0; + + if (clauses->gang) + level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level); + if (clauses->worker) + level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level); + if (clauses->vector) + level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level); + if (clauses->seq) + level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level); + + if (mask != (mask & -mask)) + gfc_error ("Multiple loop axes specified for routine"); + } + + if (level < 0) + level = GOMP_DIM_MAX; + + return level; +} match gfc_match_oacc_routine (void) { locus old_loc; - gfc_symbol *sym; + gfc_symbol *sym = NULL; match m; + gfc_omp_clauses *c = NULL; + gfc_oacc_routine_name *n = NULL; old_loc = gfc_current_locus; @@ -1640,52 +1673,85 @@ gfc_match_oacc_routine (void) goto cleanup; } - if (m == MATCH_NO - && gfc_current_ns->proc_name - && gfc_match_omp_eos () == MATCH_YES) + if (m == MATCH_YES) { - if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr, - gfc_current_ns->proc_name->name, - &old_loc)) - goto cleanup; - return MATCH_YES; - } + char buffer[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symtree *st; - if (m != MATCH_YES) - return m; + m = gfc_match_name (buffer); + if (m == MATCH_YES) + { + st = gfc_find_symtree (gfc_current_ns->sym_root, buffer); + if (st) + { + sym = st->n.sym; + if (strcmp (sym->name, gfc_current_ns->proc_name->name) == 0) + sym = NULL; + } - /* Scan for a function name. */ - m = gfc_match_symbol (&sym, 0); + if (st == NULL + || (sym + && !sym->attr.external + && !sym->attr.function + && !sym->attr.subroutine)) + { + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, " + "invalid function name %s", + (sym) ? sym->name : buffer); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } + } + else + { + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } - if (m != MATCH_YES) - { - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; + if (gfc_match_char (')') != MATCH_YES) + { + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting" + " ')' after NAME"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } } - if (!sym->attr.external && !sym->attr.function && !sym->attr.subroutine) - { - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, invalid" - " function name %qs", sym->name); - gfc_current_locus = old_loc; - return MATCH_ERROR; - } + if (gfc_match_omp_eos () != MATCH_YES + && (gfc_match_omp_clauses (&c, OACC_ROUTINE_CLAUSES, false, false, true) + != MATCH_YES)) + return MATCH_ERROR; - if (gfc_match_char (')') != MATCH_YES) + if (sym != NULL) { - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting" - " ')' after NAME"); - gfc_current_locus = old_loc; - return MATCH_ERROR; + n = gfc_get_oacc_routine_name (); + n->sym = sym; + n->clauses = NULL; + n->next = NULL; + if (gfc_current_ns->oacc_routine_names != NULL) + n->next = gfc_current_ns->oacc_routine_names; + + gfc_current_ns->oacc_routine_names = n; } - - if (gfc_match_omp_eos () != MATCH_YES) + else if (gfc_current_ns->proc_name) { - gfc_error ("Unexpected junk after !$ACC ROUTINE at %C"); - goto cleanup; + if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr, + gfc_current_ns->proc_name->name, + &old_loc)) + goto cleanup; + gfc_current_ns->proc_name->attr.oacc_function + = gfc_oacc_routine_dims (c) + 1; } - return MATCH_YES; + + if (n) + n->clauses = c; + else if (gfc_current_ns->oacc_routine) + gfc_current_ns->oacc_routine_clauses = c; + + new_st.op = EXEC_OACC_ROUTINE; + new_st.ext.omp_clauses = c; + return MATCH_YES; cleanup: gfc_current_locus = old_loc; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index b2806214e1a..b2d15a89aeb 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -5786,6 +5786,7 @@ is_oacc (gfc_state_data *sd) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ATOMIC: + case EXEC_OACC_ROUTINE: return true; default: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 685e3f54007..febf0fa28d6 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9373,6 +9373,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ATOMIC: + case EXEC_OACC_ROUTINE: case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index d0a11aab793..566150b1cc2 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -202,6 +202,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OACC_ROUTINE: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_DISTRIBUTE: diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 39ff8e27f5b..331b43da413 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -44,6 +44,7 @@ along with GCC; see the file COPYING3. If not see #include "trans-const.h" /* Only for gfc_trans_code. Shouldn't need to include this. */ #include "trans-stmt.h" +#include "gomp-constants.h" #define MAX_LABEL_VALUE 99999 @@ -1304,6 +1305,20 @@ 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) + { + tree dims = NULL_TREE; + int ix; + int level = sym_attr.oacc_function - 1; + + for (ix = GOMP_DIM_MAX; ix--;) + dims = tree_cons (build_int_cst (boolean_type_node, ix >= level), + integer_zero_node, dims); + + list = tree_cons (get_identifier ("oacc function"), + dims, list); + } + return list; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 466d357a59a..7cc59de9feb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2015-11-30 Cesar Philippidis + Nathan Sidwell + + * gfortran.dg/goacc/routine-3.f90: New test. + * gfortran.dg/goacc/routine-4.f90: New test. + * gfortran.dg/goacc/routine-5.f90: New test. + * gfortran.dg/goacc/routine-6.f90: New test. + * gfortran.dg/goacc/subroutines: New test. + 2015-11-30 Tom de Vries * gcc.dg/pr46032-2.c: New test. diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-3.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-3.f90 new file mode 100644 index 00000000000..ca9b928fa02 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-3.f90 @@ -0,0 +1,13 @@ +PROGRAM nested_gwv +CONTAINS + SUBROUTINE gwv + INTEGER :: i + REAL(KIND=8), ALLOCATABLE :: un(:), ua(:) + + !$acc parallel num_gangs(2) num_workers(4) vector_length(32) + DO jj = 1, 100 + un(i) = ua(i) + END DO + !$acc end parallel + END SUBROUTINE gwv +END PROGRAM nested_gwv diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-4.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-4.f90 new file mode 100644 index 00000000000..6714c7b8229 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-4.f90 @@ -0,0 +1,160 @@ +! Test invalid calls to routines. + +module param + integer, parameter :: N = 32 +end module param + +program main + use param + integer :: i + integer :: a(N) + + do i = 1, N + a(i) = i + end do + + ! + ! Seq routine tests. + ! + + !$acc parallel copy (a) + !$acc loop + do i = 1, N + call seq (a) + end do + + !$acc loop gang + do i = 1, N + call seq (a) + end do + + !$acc loop worker + do i = 1, N + call seq (a) + end do + + !$acc loop vector + do i = 1, N + call seq (a) + end do + !$acc end parallel + + ! + ! Gang routines loops. + ! + + !$acc parallel copy (a) + !$acc loop ! { dg-warning "insufficient partitioning" } + do i = 1, N + call gang (a) + end do + + !$acc loop gang ! { dg-message "containing loop" } + do i = 1, N + call gang (a) ! { dg-error "routine call uses same" } + end do + + !$acc loop worker ! { dg-message "containing loop" } + do i = 1, N + call gang (a) ! { dg-error "routine call uses same" } + end do + + !$acc loop vector ! { dg-message "containing loop" } + do i = 1, N + call gang (a) ! { dg-error "routine call uses same" } + end do + !$acc end parallel + + ! + ! Worker routines loops. + ! + + !$acc parallel copy (a) + !$acc loop + do i = 1, N + call worker (a) + end do + + !$acc loop gang + do i = 1, N + call worker (a) + end do + + !$acc loop worker ! { dg-message "containing loop" } + do i = 1, N + call worker (a) ! { dg-error "routine call uses same" } + end do + + !$acc loop vector ! { dg-message "containing loop" } + do i = 1, N + call worker (a) ! { dg-error "routine call uses same" } + end do + !$acc end parallel + + ! + ! Vector routines loops. + ! + + !$acc parallel copy (a) + !$acc loop + do i = 1, N + call vector (a) + end do + + !$acc loop gang + do i = 1, N + call vector (a) + end do + + !$acc loop worker + do i = 1, N + call vector (a) + end do + + !$acc loop vector ! { dg-message "containing loop" } + do i = 1, N + call vector (a) ! { dg-error "routine call uses same" } + end do + !$acc end parallel +contains + + subroutine gang (a) ! { dg-message "declared here" 3 } + !$acc routine gang + integer, intent (inout) :: a(N) + integer :: i + + do i = 1, N + a(i) = a(i) - a(i) + end do + end subroutine gang + + subroutine worker (a) ! { dg-message "declared here" 2 } + !$acc routine worker + integer, intent (inout) :: a(N) + integer :: i + + do i = 1, N + a(i) = a(i) - a(i) + end do + end subroutine worker + + subroutine vector (a) ! { dg-message "declared here" } + !$acc routine vector + integer, intent (inout) :: a(N) + integer :: i + + do i = 1, N + a(i) = a(i) - a(i) + end do + end subroutine vector + + subroutine seq (a) + !$acc routine seq + integer, intent (inout) :: a(N) + integer :: i + + do i = 1, N + a(i) = a(i) - a(i) + end do + end subroutine seq +end program main diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-5.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-5.f90 new file mode 100644 index 00000000000..68c51496866 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-5.f90 @@ -0,0 +1,109 @@ +! Test invalid intra-routine parallellism. + +module param + integer, parameter :: N = 32 +end module param + +subroutine gang (a) + !$acc routine gang + integer, intent (inout) :: a(N) + integer :: i + + !$acc loop + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop gang + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop worker + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop vector + do i = 1, N + a(i) = a(i) - a(i) + end do +end subroutine gang + +subroutine worker (a) + !$acc routine worker + integer, intent (inout) :: a(N) + integer :: i + + !$acc loop + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop gang ! { dg-error "disallowed by containing routine" } + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop worker + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop vector + do i = 1, N + a(i) = a(i) - a(i) + end do +end subroutine worker + +subroutine vector (a) + !$acc routine vector + integer, intent (inout) :: a(N) + integer :: i + + !$acc loop + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop gang ! { dg-error "disallowed by containing routine" } + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop worker ! { dg-error "disallowed by containing routine" } + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop vector + do i = 1, N + a(i) = a(i) - a(i) + end do +end subroutine vector + +subroutine seq (a) + !$acc routine seq + integer, intent (inout) :: a(N) + integer :: i + + !$acc loop ! { dg-warning "insufficient partitioning" } + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop gang ! { dg-error "disallowed by containing routine" } + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop worker ! { dg-error "disallowed by containing routine" } + do i = 1, N + a(i) = a(i) - a(i) + end do + + !$acc loop vector ! { dg-error "disallowed by containing routine" } + do i = 1, N + a(i) = a(i) - a(i) + end do +end subroutine seq diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 new file mode 100644 index 00000000000..10951ee686e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 @@ -0,0 +1,89 @@ + +module m + integer m1int +contains + subroutine subr5 (x) + implicit none + !$acc routine (subr5) + !$acc routine (m1int) ! { dg-error "invalid function name" } + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if + end subroutine subr5 +end module m + +program main + implicit none + interface + function subr6 (x) + !$acc routine (subr6) ! { dg-error "without list is allowed in interface" } + integer, intent (in) :: x + integer :: subr6 + end function subr6 + end interface + integer, parameter :: n = 10 + integer :: a(n), i + !$acc routine (subr1) ! { dg-error "invalid function name" } + external :: subr2 + !$acc routine (subr2) + !$acc parallel + !$acc loop + do i = 1, n + call subr1 (i) + call subr2 (i) + end do + !$acc end parallel +end program main + +subroutine subr1 (x) + !$acc routine + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if +end subroutine subr1 + +subroutine subr2 (x) + !$acc routine (subr1) ! { dg-error "invalid function name" } + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if +end subroutine subr2 + +subroutine subr3 (x) + !$acc routine (subr3) + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + call subr4 (x) + end if +end subroutine subr3 + +subroutine subr4 (x) + !$acc routine (subr4) + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if +end subroutine subr4 + +subroutine subr10 (x) + !$acc routine (subr10) device ! { dg-error "Unclassifiable OpenACC directive" } + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if +end subroutine subr10 diff --git a/gcc/testsuite/gfortran.dg/goacc/subroutines.f90 b/gcc/testsuite/gfortran.dg/goacc/subroutines.f90 new file mode 100644 index 00000000000..6cab798d458 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/subroutines.f90 @@ -0,0 +1,73 @@ +! Exercise how tree-nested.c handles gang, worker vector and seq. + +! { dg-do compile } + +program main + integer, parameter :: N = 100 + integer :: nonlocal_arg + integer :: nonlocal_a(N) + integer :: nonlocal_i + integer :: nonlocal_j + + nonlocal_a (:) = 5 + nonlocal_arg = 5 + + call local () + call nonlocal () + +contains + + subroutine local () + integer :: local_i + integer :: local_arg + integer :: local_a(N) + integer :: local_j + + local_a (:) = 5 + local_arg = 5 + + !$acc kernels loop gang(num:local_arg) worker(local_arg) vector(local_arg) + do local_i = 1, N + local_a(local_i) = 100 + !$acc loop seq + do local_j = 1, N + enddo + enddo + !$acc end kernels loop + + !$acc kernels loop gang(static:local_arg) worker(local_arg) & + !$acc vector(local_arg) + do local_i = 1, N + local_a(local_i) = 100 + !$acc loop seq + do local_j = 1, N + enddo + enddo + !$acc end kernels loop + end subroutine local + + subroutine nonlocal () + nonlocal_a (:) = 5 + nonlocal_arg = 5 + + !$acc kernels loop gang(num:nonlocal_arg) worker(nonlocal_arg) & + !$acc vector(nonlocal_arg) + do nonlocal_i = 1, N + nonlocal_a(nonlocal_i) = 100 + !$acc loop seq + do nonlocal_j = 1, N + enddo + enddo + !$acc end kernels loop + + !$acc kernels loop gang(static:nonlocal_arg) worker(nonlocal_arg) & + !$acc vector(nonlocal_arg) + do nonlocal_i = 1, N + nonlocal_a(nonlocal_i) = 100 + !$acc loop seq + do nonlocal_j = 1, N + enddo + enddo + !$acc end kernels loop + end subroutine nonlocal +end program main diff --git a/gcc/tree-nested.c b/gcc/tree-nested.c index 280d29b9247..8b5aba20a01 100644 --- a/gcc/tree-nested.c +++ b/gcc/tree-nested.c @@ -1108,10 +1108,31 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_NUM_TASKS: case OMP_CLAUSE_HINT: case OMP_CLAUSE__CILK_FOR_COUNT_: - wi->val_only = true; - wi->is_lhs = false; - convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), - &dummy, wi); + case OMP_CLAUSE_NUM_GANGS: + case OMP_CLAUSE_NUM_WORKERS: + case OMP_CLAUSE_VECTOR_LENGTH: + case OMP_CLAUSE_GANG: + case OMP_CLAUSE_WORKER: + case OMP_CLAUSE_VECTOR: + /* Several OpenACC clauses have optional arguments. Check if they + are present. */ + if (OMP_CLAUSE_OPERAND (clause, 0)) + { + wi->val_only = true; + wi->is_lhs = false; + convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), + &dummy, wi); + } + + /* The gang clause accepts two arguments. */ + if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_GANG + && OMP_CLAUSE_GANG_STATIC_EXPR (clause)) + { + wi->val_only = true; + wi->is_lhs = false; + convert_nonlocal_reference_op + (&OMP_CLAUSE_GANG_STATIC_EXPR (clause), &dummy, wi); + } break; case OMP_CLAUSE_DIST_SCHEDULE: @@ -1175,6 +1196,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_THREADS: case OMP_CLAUSE_SIMD: case OMP_CLAUSE_DEFAULTMAP: + case OMP_CLAUSE_SEQ: break; default: @@ -1762,10 +1784,31 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_NUM_TASKS: case OMP_CLAUSE_HINT: case OMP_CLAUSE__CILK_FOR_COUNT_: - wi->val_only = true; - wi->is_lhs = false; - convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), &dummy, - wi); + case OMP_CLAUSE_NUM_GANGS: + case OMP_CLAUSE_NUM_WORKERS: + case OMP_CLAUSE_VECTOR_LENGTH: + case OMP_CLAUSE_GANG: + case OMP_CLAUSE_WORKER: + case OMP_CLAUSE_VECTOR: + /* Several OpenACC clauses have optional arguments. Check if they + are present. */ + if (OMP_CLAUSE_OPERAND (clause, 0)) + { + wi->val_only = true; + wi->is_lhs = false; + convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), + &dummy, wi); + } + + /* The gang clause accepts two arguments. */ + if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_GANG + && OMP_CLAUSE_GANG_STATIC_EXPR (clause)) + { + wi->val_only = true; + wi->is_lhs = false; + convert_nonlocal_reference_op + (&OMP_CLAUSE_GANG_STATIC_EXPR (clause), &dummy, wi); + } break; case OMP_CLAUSE_DIST_SCHEDULE: @@ -1834,6 +1877,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_THREADS: case OMP_CLAUSE_SIMD: case OMP_CLAUSE_DEFAULTMAP: + case OMP_CLAUSE_SEQ: break; default: diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index ce2828a8301..cb8b10c9c32 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,11 @@ +2015-11-30 James Norris + Cesar Philippidis + + libgomp/ + * libgomp.oacc-fortran/routine-5.f90: New test. + * libgomp.oacc-fortran/routine-7.f90: New test. + * libgomp.oacc-fortran/routine-9.f90: New test. + 2015-11-30 Tom de Vries PR tree-optimization/46032 diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 new file mode 100644 index 00000000000..956da8ed043 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! { dg-options "-fno-inline" } + +program main + integer :: n + + n = 5 + + !$acc parallel copy (n) + n = func (n) + !$acc end parallel + + if (n .ne. 6) call abort + +contains + + function func (n) result (rc) + !$acc routine + integer, intent (in) :: n + integer :: rc + + rc = n + rc = rc + 1 + + end function + +end program diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 new file mode 100644 index 00000000000..7fc81691bfb --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 @@ -0,0 +1,121 @@ + +! { dg-do run } +! { dg-additional-options "-cpp" } + +#define M 8 +#define N 32 + +program main + integer :: i + integer :: a(N) + integer :: b(M * N) + + do i = 1, N + a(i) = 0 + end do + + !$acc parallel copy (a) + !$acc loop seq + do i = 1, N + call seq (a) + end do + !$acc end parallel + + do i = 1, N + if (a(i) .ne.N) call abort + end do + + !$acc parallel copy (a) + !$acc loop seq + do i = 1, N + call gang (a) + end do + !$acc end parallel + + do i = 1, N + if (a(i) .ne. (N + (N * (-1 * i)))) call abort + end do + + do i = 1, N + b(i) = i + end do + + !$acc parallel copy (b) + !$acc loop + do i = 1, N + call worker (b) + end do + !$acc end parallel + + do i = 1, N + if (b(i) .ne. N + i) call abort + end do + + do i = 1, N + a(i) = i + end do + + !$acc parallel copy (a) + !$acc loop + do i = 1, N + call vector (a) + end do + !$acc end parallel + + do i = 1, N + if (a(i) .ne. 0) call abort + end do + +contains + +subroutine vector (a) + !$acc routine vector + integer, intent (inout) :: a(N) + integer :: i + + !$acc loop vector + do i = 1, N + a(i) = a(i) - a(i) + end do + +end subroutine vector + +subroutine worker (b) + !$acc routine worker + integer, intent (inout) :: b(M*N) + integer :: i, j + + !$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 + end do + +end subroutine worker + +subroutine gang (a) + !$acc routine gang + integer, intent (inout) :: a(N) + integer :: i + + !$acc loop gang + do i = 1, N + a(i) = a(i) - i + end do + +end subroutine gang + +subroutine seq (a) + !$acc routine seq + integer, intent (inout) :: a(M) + integer :: i + + do i = 1, N + a(i) = a(i) + 1 + end do + +end subroutine seq + +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 new file mode 100644 index 00000000000..95d1a1392d8 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! { dg-options "-fno-inline" } + +program main + implicit none + integer, parameter :: n = 10 + integer :: a(n), i + integer, external :: fact + !$acc routine (fact) + !$acc parallel + !$acc loop + do i = 1, n + a(i) = fact (i) + end do + !$acc end parallel + do i = 1, n + if (a(i) .ne. fact(i)) call abort + end do +end program main + +recursive function fact (x) result (res) + implicit none + !$acc routine (fact) + integer, intent(in) :: x + integer :: res + if (x < 1) then + res = 1 + else + res = x * fact(x - 1) + end if +end function fact -- 2.30.2