| Message ID | d28b32ce-15cf-dc2a-99b5-541d8ff28f66@codesourcery.com |
|---|---|
| State | New |
| Headers | show |
| Series | [openacc] Teach gfortran to lower OpenACC routine dims | expand |
On Wed, 5 Sep 2018 12:52:03 -0700 Cesar Philippidis <cesar@codesourcery.com> wrote: > At present, gfortran does not encode the gang, worker or vector > parallelism clauses when it creates acc routines dim attribute for > subroutines and functions. While support for acc routine is lacking in > other areas in gfortran (including modules), this patch is important > because it encodes the parallelism attributes using the same function > as the C and C++ FEs. This will become important with the forthcoming > nvptx vector length extensions, because large vectors are not > supported in acc routines yet. > > Is this OK for trunk? I regtested and bootstrapped for x86_64 with > nvptx offloading. > diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c > index 94a7f7eaa50..d48c9351e25 100644 > --- a/gcc/fortran/openmp.c > +++ b/gcc/fortran/openmp.c > @@ -2234,34 +2234,45 @@ gfc_match_oacc_cache (void) > return MATCH_YES; > } > > -/* Determine the loop level for a routine. */ > +/* Determine the loop level for a routine. Returns > OACC_FUNCTION_NONE > + if any error is detected. */ > > -static int > +static oacc_function > gfc_oacc_routine_dims (gfc_omp_clauses *clauses) > { > int level = -1; > + oacc_function ret = OACC_FUNCTION_AUTO; > > 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); > + { > + level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level); > + ret = OACC_FUNCTION_SEQ; > + } > > if (mask != (mask & -mask)) > - gfc_error ("Multiple loop axes specified for routine"); > + ret = OACC_FUNCTION_NONE; > } > > - if (level < 0) > - level = GOMP_DIM_MAX; > - > - return level; > + return ret; > } > > match > @@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void) > match m; > gfc_omp_clauses *c = NULL; > gfc_oacc_routine_name *n = NULL; > + oacc_function dims = OACC_FUNCTION_NONE; Unneeded initialisation of dims. > + bool seen_error = false; > > old_loc = gfc_current_locus; > > @@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void) > } > else > { > - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C"); > - gfc_current_locus = old_loc; > - return MATCH_ERROR; > + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L", > &old_loc); > + goto cleanup; > } > > 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; > + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, > expecting" > + " ')' after NAME", &old_loc); > + goto cleanup; > } > } > > @@ -2337,26 +2348,83 @@ gfc_match_oacc_routine (void) > != MATCH_YES)) > return MATCH_ERROR; > > + /* Scan for invalid routine geometry. */ > + dims = gfc_oacc_routine_dims (c); > + if (dims == OACC_FUNCTION_NONE) > + { > + gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at > %L", > + &old_loc); > + > + /* Don't abort early, because it's important to let the user > + know of any potential duplicate routine directives. */ > + seen_error = true; > + } > + else if (dims == OACC_FUNCTION_AUTO) > + { > + gfc_warning (0, "Expected one of %<gang%>, %<worker%>, > %<vector%> or " > + "%<seq%> clauses in !$ACC ROUTINE at %L", > &old_loc); > + dims = OACC_FUNCTION_SEQ; > + } > + > if (sym != NULL) > { > - 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; > + bool needs_entry = true; > + > + /* Scan for any repeated routine directives on 'sym' and report > + an error if necessary. TODO: Extend this function to scan > + for compatible DEVICE_TYPE dims. */ > + for (n = gfc_current_ns->oacc_routine_names; n; n = n->next) > + if (n->sym == sym) > + { > + needs_entry = false; > + if (dims != gfc_oacc_routine_dims (n->clauses)) > + { > + gfc_error ("$!ACC ROUTINE already applied at %L", > &old_loc); > + goto cleanup; > + } > + } > + > + if (needs_entry) > + { > + n = gfc_get_oacc_routine_name (); > + n->sym = sym; > + n->clauses = c; > + n->next = NULL; > + n->loc = old_loc; > + > + if (gfc_current_ns->oacc_routine_names != NULL) > + n->next = gfc_current_ns->oacc_routine_names; Just omit n->next = NULL above and unconditionally set ->next to current ns' routine names. > + > + gfc_current_ns->oacc_routine_names = n; > + } > + > + if (seen_error) > + goto cleanup; > } > else if (gfc_current_ns->proc_name) > { > + if (gfc_current_ns->proc_name->attr.oacc_function != > OACC_FUNCTION_NONE > + && !seen_error) > + { > + gfc_error ("!$ACC ROUTINE already applied at %L", > &old_loc); > + goto cleanup; I'd move both this gfc_error and the one above to a duplicate_routine label before the cleanup label and jump to that here and for the identical gfc_error above. > + } > + > 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; > + = seen_error ? OACC_FUNCTION_SEQ : dims; why can't you use dims unconditionally after branching to cleanup if seen_error? I.e. move the seen_error check below to above the attr.oacc_function setting? > + > + if (seen_error) > + goto cleanup; > } > + else > + /* Something has gone wrong. Perhaps there was a syntax error > + in the program-stmt. */ > + goto cleanup; > > if (n) > n->clauses = c; > diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c > index eea6b81ebfa..eed868f475b 100644 > --- a/gcc/fortran/trans-decl.c > +++ b/gcc/fortran/trans-decl.c > @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not see > #include "trans-stmt.h" > #include "gomp-constants.h" > #include "gimplify.h" > +#include "omp-general.h" hmz. so the gomp-constants.h include would be redundant, but do we really need omp-general.h? Doesn't this suggest to move this oacc dims lowering to trans-openmp.c instead, please? > > #define MAX_LABEL_VALUE 99999 > > @@ -1403,16 +1404,29 @@ 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; > + omp_clause_code code = OMP_CLAUSE_ERROR; redundant initialization. > + tree clause, dims; > > - for (ix = GOMP_DIM_MAX; ix--;) > - dims = tree_cons (build_int_cst (boolean_type_node, ix >= > level), > - integer_zero_node, dims); > + switch (sym_attr.oacc_function) > + { > + case OACC_FUNCTION_GANG: > + code = OMP_CLAUSE_GANG; > + break; > + case OACC_FUNCTION_WORKER: > + code = OMP_CLAUSE_WORKER; > + break; > + case OACC_FUNCTION_VECTOR: > + code = OMP_CLAUSE_VECTOR; > + break; > + case OACC_FUNCTION_SEQ: > + default: > + code = OMP_CLAUSE_SEQ; > + } > > + clause = build_omp_clause (UNKNOWN_LOCATION, code); > + dims = oacc_build_routine_dims (clause); > list = tree_cons (get_identifier ("oacc function"), > dims, list); > } btw.. the OACC merge from the gomp4 branch added a copy'n paste error in an error message. May i ask you to regtest and install the below: diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index fcfe671be8b..ac1f4fc7619 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -5848,13 +5848,13 @@ resolve_oacc_loop_blocks (gfc_code *code) if (c->code->ext.omp_clauses->worker) gfc_error ("Loop parallelized across gangs is not allowed " "inside loop parallelized across workers at %L", &code->loc); if (c->code->ext.omp_clauses->vector) gfc_error ("Loop parallelized across gangs is not allowed " - "inside loop parallelized across workers at %L", + "inside loop parallelized across vectors at %L", &code->loc); } if (code->ext.omp_clauses->worker) { if (c->code->ext.omp_clauses->worker) gfc_error ("Loop parallelized across workers is not allowed " thanks,
On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote: > On Wed, 5 Sep 2018 12:52:03 -0700 > Cesar Philippidis <cesar@codesourcery.com> wrote: > >> At present, gfortran does not encode the gang, worker or vector >> parallelism clauses when it creates acc routines dim attribute for >> subroutines and functions. While support for acc routine is lacking in >> other areas in gfortran (including modules), this patch is important >> because it encodes the parallelism attributes using the same function >> as the C and C++ FEs. This will become important with the forthcoming >> nvptx vector length extensions, because large vectors are not >> supported in acc routines yet. >> >> Is this OK for trunk? I regtested and bootstrapped for x86_64 with >> nvptx offloading. > >> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c >> index 94a7f7eaa50..d48c9351e25 100644 >> --- a/gcc/fortran/openmp.c >> +++ b/gcc/fortran/openmp.c >> @@ -2234,34 +2234,45 @@ gfc_match_oacc_cache (void) >> return MATCH_YES; >> } >> >> -/* Determine the loop level for a routine. */ >> +/* Determine the loop level for a routine. Returns >> OACC_FUNCTION_NONE >> + if any error is detected. */ >> >> -static int >> +static oacc_function >> gfc_oacc_routine_dims (gfc_omp_clauses *clauses) >> { >> int level = -1; >> + oacc_function ret = OACC_FUNCTION_AUTO; >> >> 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); >> + { >> + level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level); >> + ret = OACC_FUNCTION_SEQ; >> + } >> >> if (mask != (mask & -mask)) >> - gfc_error ("Multiple loop axes specified for routine"); >> + ret = OACC_FUNCTION_NONE; >> } >> >> - if (level < 0) >> - level = GOMP_DIM_MAX; >> - >> - return level; >> + return ret; >> } >> >> match >> @@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void) >> match m; >> gfc_omp_clauses *c = NULL; >> gfc_oacc_routine_name *n = NULL; >> + oacc_function dims = OACC_FUNCTION_NONE; > > Unneeded initialisation of dims. ACK. >> + bool seen_error = false; >> >> old_loc = gfc_current_locus; >> >> @@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void) >> } >> else >> { >> - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C"); >> - gfc_current_locus = old_loc; >> - return MATCH_ERROR; >> + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L", >> &old_loc); >> + goto cleanup; >> } >> >> 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; >> + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, >> expecting" >> + " ')' after NAME", &old_loc); >> + goto cleanup; >> } >> } >> >> @@ -2337,26 +2348,83 @@ gfc_match_oacc_routine (void) >> != MATCH_YES)) >> return MATCH_ERROR; >> >> + /* Scan for invalid routine geometry. */ >> + dims = gfc_oacc_routine_dims (c); >> + if (dims == OACC_FUNCTION_NONE) >> + { >> + gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at >> %L", >> + &old_loc); >> + >> + /* Don't abort early, because it's important to let the user >> + know of any potential duplicate routine directives. */ >> + seen_error = true; >> + } >> + else if (dims == OACC_FUNCTION_AUTO) >> + { >> + gfc_warning (0, "Expected one of %<gang%>, %<worker%>, >> %<vector%> or " >> + "%<seq%> clauses in !$ACC ROUTINE at %L", >> &old_loc); >> + dims = OACC_FUNCTION_SEQ; >> + } >> + >> if (sym != NULL) >> { >> - 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; >> + bool needs_entry = true; >> + >> + /* Scan for any repeated routine directives on 'sym' and report >> + an error if necessary. TODO: Extend this function to scan >> + for compatible DEVICE_TYPE dims. */ >> + for (n = gfc_current_ns->oacc_routine_names; n; n = n->next) >> + if (n->sym == sym) >> + { >> + needs_entry = false; >> + if (dims != gfc_oacc_routine_dims (n->clauses)) >> + { >> + gfc_error ("$!ACC ROUTINE already applied at %L", >> &old_loc); >> + goto cleanup; >> + } >> + } >> + >> + if (needs_entry) >> + { >> + n = gfc_get_oacc_routine_name (); >> + n->sym = sym; >> + n->clauses = c; >> + n->next = NULL; >> + n->loc = old_loc; >> + >> + if (gfc_current_ns->oacc_routine_names != NULL) >> + n->next = gfc_current_ns->oacc_routine_names; > > Just omit n->next = NULL above and unconditionally set ->next to current > ns' routine names. ACK. >> + >> + gfc_current_ns->oacc_routine_names = n; >> + } >> + >> + if (seen_error) >> + goto cleanup; >> } >> else if (gfc_current_ns->proc_name) >> { >> + if (gfc_current_ns->proc_name->attr.oacc_function != >> OACC_FUNCTION_NONE >> + && !seen_error) >> + { >> + gfc_error ("!$ACC ROUTINE already applied at %L", >> &old_loc); >> + goto cleanup; > > I'd move both this gfc_error and the one above to a duplicate_routine > label before the cleanup label and jump to that here and for the > identical gfc_error above. I did it this way because we have a forthcoming patch which adds support for Fortran modules, and that patch has a different set of errors. That said, I'll incorporate those changes and modify the patch. >> + } >> + >> 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; >> + = seen_error ? OACC_FUNCTION_SEQ : dims; > > why can't you use dims unconditionally after branching to cleanup if > seen_error? I.e. move the seen_error check below to above the > attr.oacc_function setting? Yeah, it probably doesn't matter much if the function returns MATCH_ERROR. I'll change it. >> + >> + if (seen_error) >> + goto cleanup; >> } >> + else >> + /* Something has gone wrong. Perhaps there was a syntax error >> + in the program-stmt. */ >> + goto cleanup; >> >> if (n) >> n->clauses = c; >> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c >> index eea6b81ebfa..eed868f475b 100644 >> --- a/gcc/fortran/trans-decl.c >> +++ b/gcc/fortran/trans-decl.c >> @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not see >> #include "trans-stmt.h" >> #include "gomp-constants.h" >> #include "gimplify.h" >> +#include "omp-general.h" > > hmz. so the gomp-constants.h include would be redundant, but do we > really need omp-general.h? Good point. omp-general.h is required for oacc_build_routine_dims. > Doesn't this suggest to move this oacc dims lowering to trans-openmp.c > instead, please? So something like adding a new gfc_add_omp_offload_attributes to trans-openmp.c and call it from add_attributes_to_decl? >> #define MAX_LABEL_VALUE 99999 >> >> @@ -1403,16 +1404,29 @@ 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; >> + omp_clause_code code = OMP_CLAUSE_ERROR; > > redundant initialization. ACK. >> + tree clause, dims; >> >> - for (ix = GOMP_DIM_MAX; ix--;) >> - dims = tree_cons (build_int_cst (boolean_type_node, ix >= >> level), >> - integer_zero_node, dims); >> + switch (sym_attr.oacc_function) >> + { >> + case OACC_FUNCTION_GANG: >> + code = OMP_CLAUSE_GANG; >> + break; >> + case OACC_FUNCTION_WORKER: >> + code = OMP_CLAUSE_WORKER; >> + break; >> + case OACC_FUNCTION_VECTOR: >> + code = OMP_CLAUSE_VECTOR; >> + break; >> + case OACC_FUNCTION_SEQ: >> + default: >> + code = OMP_CLAUSE_SEQ; >> + } >> >> + clause = build_omp_clause (UNKNOWN_LOCATION, code); >> + dims = oacc_build_routine_dims (clause); >> list = tree_cons (get_identifier ("oacc function"), >> dims, list); >> } On a related note, I noticed that I forgot to incorporate this change in gfortran.h: @@ -902,7 +912,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; It's probably not huge, but I noticed that some other enum bitfields are declared that way. > btw.. the OACC merge from the gomp4 branch added a copy'n paste error > in an error message. May i ask you to regtest and install the below: > > diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c > index fcfe671be8b..ac1f4fc7619 100644 > --- a/gcc/fortran/openmp.c > +++ b/gcc/fortran/openmp.c > @@ -5848,13 +5848,13 @@ resolve_oacc_loop_blocks (gfc_code *code) > if (c->code->ext.omp_clauses->worker) > gfc_error ("Loop parallelized across gangs is not > allowed " "inside loop parallelized across workers at %L", > &code->loc); > if (c->code->ext.omp_clauses->vector) > gfc_error ("Loop parallelized across gangs is not > allowed " > - "inside loop parallelized across workers > at %L", > + "inside loop parallelized across vectors > at %L", &code->loc); > } > if (code->ext.omp_clauses->worker) > { > if (c->code->ext.omp_clauses->worker) > gfc_error ("Loop parallelized across workers is not > allowed " Sure. That looks reasonable. I'll also update and/or add new tests as necessary. Thanks for the review. I have couple in my queue already, but I hope to have both my updated patch and your patch ready early next week. This week I've been preparing a bunch of miscellaneous OpenACC patches, but next week return to OpenACC routine patches. In terms of Fortran, I have a patch that introduces support for the nohost routine clause (and the bind clause, but bind hasn't been implemented in the middle end yet, so I won't include it), as well as a patch the aforementioned routine support in Fortran modules. Cesar
On Thu, 20 Sep 2018 07:41:08 -0700 Cesar Philippidis <cesar@codesourcery.com> wrote: > On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote: > > On Wed, 5 Sep 2018 12:52:03 -0700 > > Cesar Philippidis <cesar@codesourcery.com> wrote: > >> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c > >> index eea6b81ebfa..eed868f475b 100644 > >> --- a/gcc/fortran/trans-decl.c > >> +++ b/gcc/fortran/trans-decl.c > >> @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not > >> see #include "trans-stmt.h" > >> #include "gomp-constants.h" > >> #include "gimplify.h" > >> +#include "omp-general.h" > > > > hmz. so the gomp-constants.h include would be redundant, but do we > > really need omp-general.h? > > Good point. omp-general.h is required for oacc_build_routine_dims. > > > Doesn't this suggest to move this oacc dims lowering to > > trans-openmp.c instead, please? > > So something like adding a new gfc_add_omp_offload_attributes to > trans-openmp.c and call it from add_attributes_to_decl? yes. > On a related note, I noticed that I forgot to incorporate this change > in gfortran.h: > > @@ -902,7 +912,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; > > It's probably not huge, but I noticed that some other enum bitfields > are declared that way. yea, some compilers had trouble with enum bitfields (where plain int bitfields like here worked fine, IIRC) but i'm not sure if it's considered legacy these days. Fine with me to be safe. > > > btw.. the OACC merge from the gomp4 branch added a copy'n paste > > error in an error message. May i ask you to regtest and install the > > below: > Sure. That looks reasonable. I'll also update and/or add new tests as > necessary. TIA and cheers,
On 09/20/2018 09:10 AM, Bernhard Reutner-Fischer wrote: > On Thu, 20 Sep 2018 07:41:08 -0700 > Cesar Philippidis <cesar@codesourcery.com> wrote: > >> On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote: >>> On Wed, 5 Sep 2018 12:52:03 -0700 >>> Cesar Philippidis <cesar@codesourcery.com> wrote: > >>>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c >>>> index eea6b81ebfa..eed868f475b 100644 >>>> --- a/gcc/fortran/trans-decl.c >>>> +++ b/gcc/fortran/trans-decl.c >>>> @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not >>>> see #include "trans-stmt.h" >>>> #include "gomp-constants.h" >>>> #include "gimplify.h" >>>> +#include "omp-general.h" >>> >>> hmz. so the gomp-constants.h include would be redundant, but do we >>> really need omp-general.h? >> >> Good point. omp-general.h is required for oacc_build_routine_dims. >> >>> Doesn't this suggest to move this oacc dims lowering to >>> trans-openmp.c instead, please? >> >> So something like adding a new gfc_add_omp_offload_attributes to >> trans-openmp.c and call it from add_attributes_to_decl? > > yes. > >> On a related note, I noticed that I forgot to incorporate this change >> in gfortran.h: >> >> @@ -902,7 +912,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; >> >> It's probably not huge, but I noticed that some other enum bitfields >> are declared that way. > > yea, some compilers had trouble with enum bitfields (where plain int > bitfields like here worked fine, IIRC) but i'm not sure if it's > considered legacy these days. Fine with me to be safe. I updated the patch by incorporating all of those changes. Is it OK for trunk? Thanks, Cesar [openacc] Make GFC default to -1 for OpenACC routine dims 2018-09-24 Cesar Philippidis <cesar@codesourcery.com> * gfortran.h (enum oacc_function): New enum. (gfc_oacc_routine_name): Add locus loc field. (symbol_attribute): Update type of oacc_function field. * openmp.c (gfc_oacc_routine_dims): Return oacc_function. (gfc_match_oacc_routine): Update routine clause syntax checking. Populate oacc_function attribute with dims. * trans-decl.c (add_attributes_to_decl): Use oacc_build_routine_dims to construct routine dims. * trans.h (gfc_add_omp_offload_attributes): Declare. * trans-decl.c (add_attributes_to_decl): Use it to set OMP and ACC offload function attributes. * trans-openmp.c (gfc_add_omp_offload_attributes): New function. gcc/testsuite/ * gfortran.dg/goacc/classify-routine.f95: Adjust test. * gfortran.dg/goacc/pr71704.f90: Likewise. * gfortran.dg/goacc/routine-6.f90: Likewise. * gfortran.dg/goacc/routine-8.f90: Likewise. * gfortran.dg/goacc/routine-level-of-parallelism-1.f90: Likewise. libgomp/ * testsuite/libgomp.oacc-fortran/routine-1.f90: Adjust test. * testsuite/libgomp.oacc-fortran/routine-2.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-3.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-4.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-5.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-9.f90: Likewise. * libgomp.oacc-fortran/host_data-2.f90: Likewise. * libgomp.oacc-fortran/host_data-3.f: Likewise. * libgomp.oacc-fortran/host_data-4.f90: Likewise. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 04b0024a992..3efd59c95f7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -316,6 +316,16 @@ 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_GANG, + OACC_FUNCTION_WORKER, + OACC_FUNCTION_VECTOR, + OACC_FUNCTION_SEQ, + OACC_FUNCTION_AUTO +}; + /* 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. */ @@ -902,7 +912,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; @@ -1726,6 +1736,7 @@ typedef struct gfc_oacc_routine_name struct gfc_symbol *sym; struct gfc_omp_clauses *clauses; struct gfc_oacc_routine_name *next; + locus loc; } gfc_oacc_routine_name; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 94a7f7eaa50..ac1923ea06b 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2234,34 +2234,45 @@ gfc_match_oacc_cache (void) return MATCH_YES; } -/* Determine the loop level for a routine. */ +/* Determine the loop level for a routine. Returns OACC_FUNCTION_NONE + if any error is detected. */ -static int +static oacc_function gfc_oacc_routine_dims (gfc_omp_clauses *clauses) { int level = -1; + oacc_function ret = OACC_FUNCTION_AUTO; 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); + { + level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level); + ret = OACC_FUNCTION_SEQ; + } if (mask != (mask & -mask)) - gfc_error ("Multiple loop axes specified for routine"); + ret = OACC_FUNCTION_NONE; } - if (level < 0) - level = GOMP_DIM_MAX; - - return level; + return ret; } match @@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void) match m; gfc_omp_clauses *c = NULL; gfc_oacc_routine_name *n = NULL; + oacc_function dims; + bool seen_error = false; old_loc = gfc_current_locus; @@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void) } else { - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L", &old_loc); + goto cleanup; } 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; + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, expecting" + " ')' after NAME", &old_loc); + goto cleanup; } } @@ -2337,26 +2348,72 @@ gfc_match_oacc_routine (void) != MATCH_YES)) return MATCH_ERROR; + /* Scan for invalid routine geometry. */ + dims = gfc_oacc_routine_dims (c); + if (dims == OACC_FUNCTION_NONE) + { + gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %L", + &old_loc); + + /* Don't abort early, because it's important to let the user + know of any potential duplicate routine directives. */ + seen_error = true; + } + else if (dims == OACC_FUNCTION_AUTO) + { + gfc_warning (0, "Expected one of %<gang%>, %<worker%>, %<vector%> or " + "%<seq%> clauses in !$ACC ROUTINE at %L", &old_loc); + dims = OACC_FUNCTION_SEQ; + } + if (sym != NULL) { - 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; + bool needs_entry = true; + + /* Scan for any repeated routine directives on 'sym' and report + an error if necessary. TODO: Extend this function to scan + for compatible DEVICE_TYPE dims. */ + for (n = gfc_current_ns->oacc_routine_names; n; n = n->next) + if (n->sym == sym) + { + needs_entry = false; + if (dims != gfc_oacc_routine_dims (n->clauses)) + goto duplicate_routine; + } + + if (needs_entry) + { + n = gfc_get_oacc_routine_name (); + n->sym = sym; + n->clauses = c; + n->loc = old_loc; + n->next = gfc_current_ns->oacc_routine_names; + gfc_current_ns->oacc_routine_names = n; + } + + if (seen_error) + goto cleanup; } else if (gfc_current_ns->proc_name) { + if (gfc_current_ns->proc_name->attr.oacc_function != OACC_FUNCTION_NONE + && !seen_error) + goto duplicate_routine; + 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; + + gfc_current_ns->proc_name->attr.oacc_function = dims; + + if (seen_error) + goto cleanup; } + else + /* Something has gone wrong. Perhaps there was a syntax error + in the program-stmt. */ + goto cleanup; if (n) n->clauses = c; @@ -2367,6 +2424,9 @@ gfc_match_oacc_routine (void) new_st.ext.omp_clauses = c; return MATCH_YES; +duplicate_routine: + gfc_error ("!$ACC ROUTINE already applied at %L", &old_loc); + cleanup: gfc_current_locus = old_loc; return MATCH_ERROR; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 06066eb93dd..e2e96da9a57 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -44,7 +44,6 @@ 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" #include "gimplify.h" #define MAX_LABEL_VALUE 99999 @@ -1396,26 +1395,7 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = chainon (list, attr); } - if (sym_attr.omp_declare_target_link) - list = tree_cons (get_identifier ("omp declare target link"), - NULL_TREE, list); - else if (sym_attr.omp_declare_target) - 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); - } + list = gfc_add_omp_offload_attributes (sym_attr, list); return list; } diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index f038f4c5bf8..753272d84c2 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1281,6 +1281,48 @@ gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type) } } +/* Add OpenMP / OpenACC function attributes to LIST. */ + +tree +gfc_add_omp_offload_attributes (symbol_attribute sym_attr, tree list) +{ + if (sym_attr.omp_declare_target_link) + list = tree_cons (get_identifier ("omp declare target link"), + NULL_TREE, list); + else if (sym_attr.omp_declare_target) + list = tree_cons (get_identifier ("omp declare target"), + NULL_TREE, list); + + if (sym_attr.oacc_function != OACC_FUNCTION_NONE) + { + omp_clause_code code; + tree clause, dims; + + switch (sym_attr.oacc_function) + { + case OACC_FUNCTION_GANG: + code = OMP_CLAUSE_GANG; + break; + case OACC_FUNCTION_WORKER: + code = OMP_CLAUSE_WORKER; + break; + case OACC_FUNCTION_VECTOR: + code = OMP_CLAUSE_VECTOR; + break; + case OACC_FUNCTION_SEQ: + default: + code = OMP_CLAUSE_SEQ; + } + + clause = build_omp_clause (UNKNOWN_LOCATION, code); + dims = oacc_build_routine_dims (clause); + list = tree_cons (get_identifier ("oacc function"), + dims, list); + } + + return list; +} + static inline tree gfc_trans_add_clause (tree node, tree tail) diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 1813882fe36..ecaf3d87827 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -780,6 +780,7 @@ bool gfc_omp_private_debug_clause (tree, bool); bool gfc_omp_private_outer_ref (tree); struct gimplify_omp_ctx; void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); +tree gfc_add_omp_offload_attributes (symbol_attribute, tree); /* Runtime library function decls. */ extern GTY(()) tree gfor_fndecl_pause_numeric; diff --git a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 index 4ca406742f9..445ff9afd4e 100644 --- a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 @@ -20,10 +20,10 @@ subroutine ROUTINE end subroutine ROUTINE ! Check the offloaded function's attributes. -! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } } +! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } } ! Check the offloaded function's classification and compute dimensions (will ! always be 1 x 1 x 1 for non-offloading compilation). ! { dg-final { scan-tree-dump-times "(?n)Function is OpenACC routine level 1" 1 "oaccdevlow" } } ! { dg-final { scan-tree-dump-times "(?n)Compute dimensions \\\[1, 1, 1\\\]" 1 "oaccdevlow" } } -! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } } +! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 index 0235e85d42a..92d0c71d75c 100644 --- a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 @@ -2,7 +2,7 @@ ! { dg-do compile } real function f1 () -!$acc routine (f1) +!$acc routine (f1) seq f1 = 1 end diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 index 10943cff304..5c1f652ff6d 100644 --- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 @@ -4,8 +4,7 @@ module m contains subroutine subr5 (x) implicit none - !$acc routine (subr5) - !$acc routine (m1int) ! { dg-error "invalid function name" } + !$acc routine (subr5) seq integer, intent(inout) :: x if (x < 1) then x = 1 @@ -19,22 +18,21 @@ program main implicit none interface function subr6 (x) - !$acc routine (subr6) ! { dg-error "without list is allowed in interface" } + !$acc routine (subr6) seq ! { 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 routine (subr2) seq external :: R1, R2 - !$acc routine (R1 R2 R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" } - !$acc routine (R1, R2, R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" } - !$acc routine (R1) - !$acc routine (R2) + !$acc routine (R1 R2 R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" } + !$acc routine (R1, R2, R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" } + !$acc routine (R1) seq + !$acc routine (R2) seq !$acc parallel !$acc loop @@ -46,7 +44,7 @@ program main end program main subroutine subr1 (x) - !$acc routine + !$acc routine seq integer, intent(inout) :: x if (x < 1) then x = 1 @@ -56,7 +54,6 @@ subroutine subr1 (x) end subroutine subr1 subroutine subr2 (x) - !$acc routine (subr1) ! { dg-error "invalid function name" } integer, intent(inout) :: x if (x < 1) then x = 1 @@ -66,7 +63,7 @@ subroutine subr2 (x) end subroutine subr2 subroutine subr3 (x) - !$acc routine (subr3) + !$acc routine (subr3) seq integer, intent(inout) :: x if (x < 1) then x = 1 @@ -76,7 +73,7 @@ subroutine subr3 (x) end subroutine subr3 subroutine subr4 (x) - !$acc routine (subr4) + !$acc routine (subr4) seq integer, intent(inout) :: x if (x < 1) then x = 1 @@ -86,7 +83,6 @@ subroutine subr4 (x) 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 diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 index c9039153885..beca43f2d60 100644 --- a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 @@ -4,7 +4,7 @@ program main interface function s_1 (a) integer a - !$acc routine + !$acc routine seq end function s_1 end interface @@ -18,7 +18,7 @@ program main interface function s_3 (a) integer a - !$acc routine (s_3) ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" } + !$acc routine (s_3) seq ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" } end function s_3 end interface diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 index 75dd1b01f6f..efc1b400add 100644 --- a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 @@ -7,7 +7,7 @@ subroutine g_1 end subroutine g_1 subroutine s_1_2a - !$acc routine + !$acc routine seq end subroutine s_1_2a subroutine s_1_2b @@ -15,7 +15,7 @@ subroutine s_1_2b end subroutine s_1_2b subroutine s_1_2c - !$acc routine (s_1_2c) + !$acc routine (s_1_2c) seq end subroutine s_1_2c subroutine s_1_2d @@ -25,7 +25,7 @@ end subroutine s_1_2d module s_2 contains subroutine s_2_1a - !$acc routine + !$acc routine seq end subroutine s_2_1a subroutine s_2_1b @@ -33,7 +33,7 @@ contains end subroutine s_2_1b subroutine s_2_1c - !$acc routine (s_2_1c) + !$acc routine (s_2_1c) seq end subroutine s_2_1c subroutine s_2_1d @@ -48,7 +48,7 @@ subroutine test interface function s_3_1a (a) integer a - !$acc routine + !$acc routine seq end function s_3_1a end interface diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 index ff0921863f6..4cdaa0c4d60 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 @@ -81,7 +81,7 @@ subroutine saxpy (nn, aa, xx, yy) integer :: nn real*4 :: aa, xx(nn), yy(nn) integer i - !$acc routine + !$acc routine seq do i = 1, nn yy(i) = yy(i) + aa * xx(i) diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f index 05ed949ee5c..fe0b904bb91 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f +++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f @@ -67,7 +67,7 @@ integer :: nn real*4 :: aa, xx(nn), yy(nn) integer i -!$acc routine +!$acc routine seq do i = 1, nn yy(i) = yy(i) + aa * xx(i) diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 index 6e379b5485b..e192c59a97c 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 @@ -21,7 +21,7 @@ contains integer :: nn real*4 :: aa, xx(nn), yy(nn) integer i - !$acc routine + !$acc routine seq do i = 1, nn yy(i) = yy(i) + aa * xx(i) diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 index 6a573218b7a..346e875ba00 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 @@ -3,7 +3,7 @@ interface recursive function fact (x) - !$acc routine + !$acc routine seq integer, intent(in) :: x integer :: fact end function fact @@ -21,7 +21,7 @@ end do end recursive function fact (x) result (res) - !$acc routine + !$acc routine seq integer, intent(in) :: x integer :: res if (x < 1) then diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 index b6979747902..1391979291c 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 @@ -4,7 +4,7 @@ module m1 contains recursive function fact (x) result (res) - !$acc routine + !$acc routine seq integer, intent(in) :: x integer :: res if (x < 1) then diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 index e7b9d8ab364..6f49db97b80 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 @@ -4,7 +4,7 @@ integer, parameter :: n = 10 integer :: a(n), i integer, external :: fact - !$acc routine (fact) + !$acc routine (fact) seq !$acc parallel !$acc loop do i = 1, n @@ -16,7 +16,7 @@ end do end recursive function fact (x) result (res) - !$acc routine + !$acc routine seq integer, intent(in) :: x integer :: res if (x < 1) then diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 index a96363b8cde..85bdb2a0a07 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 @@ -17,7 +17,7 @@ end do end subroutine incr (x) - !$acc routine + !$acc routine seq integer, intent(inout) :: x x = x + 1 end subroutine incr diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 index a803ad96bb5..88d65741b7c 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 @@ -15,7 +15,7 @@ program main contains function func (n) result (rc) - !$acc routine + !$acc routine seq integer, intent (in) :: n integer :: rc diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 index f58a95fe670..a83e92ab129 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 @@ -1,4 +1,3 @@ - ! { dg-do run } ! { dg-additional-options "-cpp" } @@ -100,7 +99,7 @@ subroutine gang (a) integer, intent (inout) :: a(N) integer :: i - !$acc loop gang + !$acc loop gang worker vector do i = 1, N a(i) = a(i) - i end do diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 index b1a1338dd8c..4a1250405cb 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 @@ -6,7 +6,7 @@ program main integer, parameter :: n = 10 integer :: a(n), i integer, external :: fact - !$acc routine (fact) + !$acc routine (fact) seq !$acc parallel !$acc loop do i = 1, n @@ -20,7 +20,7 @@ end program main recursive function fact (x) result (res) implicit none - !$acc routine (fact) + !$acc routine (fact) seq integer, intent(in) :: x integer :: res if (x < 1) then
On 24 September 2018 16:45:38 CEST, Cesar Philippidis <cesar@codesourcery.com> wrote: >I updated the patch by incorporating all of those changes. Is it OK for >trunk? LGTM but I cannot approve it. thanks,
[openacc] Teach gfortran to lower OpenACC routine dims gcc/fortran/ * gfortran.h (oacc_function): New enum. (gfc_oacc_routine_name): Add locus loc field. * openmp.c (gfc_oacc_routine_dims): Return oacc_function. (gfc_match_oacc_routine): Update routine clause syntax checking. Populate oacc_function attribute with dims. * trans-decl.c (add_attributes_to_decl): Use oacc_build_routine_dims to construct routine dims. gcc/testsuite/ * gfortran.dg/goacc/classify-routine.f95: Adjust test. * gfortran.dg/goacc/pr71704.f90: Likewise. * gfortran.dg/goacc/routine-6.f90: Likewise. * gfortran.dg/goacc/routine-8.f90: Likewise. * gfortran.dg/goacc/routine-level-of-parallelism-1.f90: Likewise. libgomp/ * testsuite/libgomp.oacc-fortran/routine-1.f90: Adjust test. * testsuite/libgomp.oacc-fortran/routine-2.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-3.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-4.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-5.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise. * testsuite/libgomp.oacc-fortran/routine-9.f90: Likewise. * libgomp.oacc-fortran/host_data-2.f90: Likewise. * libgomp.oacc-fortran/host_data-3.f: Likewise. * libgomp.oacc-fortran/host_data-4.f90: Likewise. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 04b0024a992..3675f2e8d52 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -316,6 +316,16 @@ 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_GANG, + OACC_FUNCTION_WORKER, + OACC_FUNCTION_VECTOR, + OACC_FUNCTION_SEQ, + OACC_FUNCTION_AUTO +}; + /* 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. */ @@ -1726,6 +1736,7 @@ typedef struct gfc_oacc_routine_name struct gfc_symbol *sym; struct gfc_omp_clauses *clauses; struct gfc_oacc_routine_name *next; + locus loc; } gfc_oacc_routine_name; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 94a7f7eaa50..d48c9351e25 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2234,34 +2234,45 @@ gfc_match_oacc_cache (void) return MATCH_YES; } -/* Determine the loop level for a routine. */ +/* Determine the loop level for a routine. Returns OACC_FUNCTION_NONE + if any error is detected. */ -static int +static oacc_function gfc_oacc_routine_dims (gfc_omp_clauses *clauses) { int level = -1; + oacc_function ret = OACC_FUNCTION_AUTO; 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); + { + level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level); + ret = OACC_FUNCTION_SEQ; + } if (mask != (mask & -mask)) - gfc_error ("Multiple loop axes specified for routine"); + ret = OACC_FUNCTION_NONE; } - if (level < 0) - level = GOMP_DIM_MAX; - - return level; + return ret; } match @@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void) match m; gfc_omp_clauses *c = NULL; gfc_oacc_routine_name *n = NULL; + oacc_function dims = OACC_FUNCTION_NONE; + bool seen_error = false; old_loc = gfc_current_locus; @@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void) } else { - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L", &old_loc); + goto cleanup; } 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; + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, expecting" + " ')' after NAME", &old_loc); + goto cleanup; } } @@ -2337,26 +2348,83 @@ gfc_match_oacc_routine (void) != MATCH_YES)) return MATCH_ERROR; + /* Scan for invalid routine geometry. */ + dims = gfc_oacc_routine_dims (c); + if (dims == OACC_FUNCTION_NONE) + { + gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %L", + &old_loc); + + /* Don't abort early, because it's important to let the user + know of any potential duplicate routine directives. */ + seen_error = true; + } + else if (dims == OACC_FUNCTION_AUTO) + { + gfc_warning (0, "Expected one of %<gang%>, %<worker%>, %<vector%> or " + "%<seq%> clauses in !$ACC ROUTINE at %L", &old_loc); + dims = OACC_FUNCTION_SEQ; + } + if (sym != NULL) { - 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; + bool needs_entry = true; + + /* Scan for any repeated routine directives on 'sym' and report + an error if necessary. TODO: Extend this function to scan + for compatible DEVICE_TYPE dims. */ + for (n = gfc_current_ns->oacc_routine_names; n; n = n->next) + if (n->sym == sym) + { + needs_entry = false; + if (dims != gfc_oacc_routine_dims (n->clauses)) + { + gfc_error ("$!ACC ROUTINE already applied at %L", &old_loc); + goto cleanup; + } + } + + if (needs_entry) + { + n = gfc_get_oacc_routine_name (); + n->sym = sym; + n->clauses = c; + n->next = NULL; + n->loc = old_loc; + + if (gfc_current_ns->oacc_routine_names != NULL) + n->next = gfc_current_ns->oacc_routine_names; + + gfc_current_ns->oacc_routine_names = n; + } + + if (seen_error) + goto cleanup; } else if (gfc_current_ns->proc_name) { + if (gfc_current_ns->proc_name->attr.oacc_function != OACC_FUNCTION_NONE + && !seen_error) + { + gfc_error ("!$ACC ROUTINE already applied at %L", &old_loc); + 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; + = seen_error ? OACC_FUNCTION_SEQ : dims; + + if (seen_error) + goto cleanup; } + else + /* Something has gone wrong. Perhaps there was a syntax error + in the program-stmt. */ + goto cleanup; if (n) n->clauses = c; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index eea6b81ebfa..eed868f475b 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not see #include "trans-stmt.h" #include "gomp-constants.h" #include "gimplify.h" +#include "omp-general.h" #define MAX_LABEL_VALUE 99999 @@ -1403,16 +1404,29 @@ 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; + omp_clause_code code = OMP_CLAUSE_ERROR; + tree clause, dims; - for (ix = GOMP_DIM_MAX; ix--;) - dims = tree_cons (build_int_cst (boolean_type_node, ix >= level), - integer_zero_node, dims); + switch (sym_attr.oacc_function) + { + case OACC_FUNCTION_GANG: + code = OMP_CLAUSE_GANG; + break; + case OACC_FUNCTION_WORKER: + code = OMP_CLAUSE_WORKER; + break; + case OACC_FUNCTION_VECTOR: + code = OMP_CLAUSE_VECTOR; + break; + case OACC_FUNCTION_SEQ: + default: + code = OMP_CLAUSE_SEQ; + } + clause = build_omp_clause (UNKNOWN_LOCATION, code); + dims = oacc_build_routine_dims (clause); list = tree_cons (get_identifier ("oacc function"), dims, list); } diff --git a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 index 4ca406742f9..445ff9afd4e 100644 --- a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 @@ -20,10 +20,10 @@ subroutine ROUTINE end subroutine ROUTINE ! Check the offloaded function's attributes. -! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } } +! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } } ! Check the offloaded function's classification and compute dimensions (will ! always be 1 x 1 x 1 for non-offloading compilation). ! { dg-final { scan-tree-dump-times "(?n)Function is OpenACC routine level 1" 1 "oaccdevlow" } } ! { dg-final { scan-tree-dump-times "(?n)Compute dimensions \\\[1, 1, 1\\\]" 1 "oaccdevlow" } } -! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } } +! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 index 0235e85d42a..92d0c71d75c 100644 --- a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 @@ -2,7 +2,7 @@ ! { dg-do compile } real function f1 () -!$acc routine (f1) +!$acc routine (f1) seq f1 = 1 end diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 index 10943cff304..5c1f652ff6d 100644 --- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 @@ -4,8 +4,7 @@ module m contains subroutine subr5 (x) implicit none - !$acc routine (subr5) - !$acc routine (m1int) ! { dg-error "invalid function name" } + !$acc routine (subr5) seq integer, intent(inout) :: x if (x < 1) then x = 1 @@ -19,22 +18,21 @@ program main implicit none interface function subr6 (x) - !$acc routine (subr6) ! { dg-error "without list is allowed in interface" } + !$acc routine (subr6) seq ! { 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 routine (subr2) seq external :: R1, R2 - !$acc routine (R1 R2 R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" } - !$acc routine (R1, R2, R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" } - !$acc routine (R1) - !$acc routine (R2) + !$acc routine (R1 R2 R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" } + !$acc routine (R1, R2, R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" } + !$acc routine (R1) seq + !$acc routine (R2) seq !$acc parallel !$acc loop @@ -46,7 +44,7 @@ program main end program main subroutine subr1 (x) - !$acc routine + !$acc routine seq integer, intent(inout) :: x if (x < 1) then x = 1 @@ -56,7 +54,6 @@ subroutine subr1 (x) end subroutine subr1 subroutine subr2 (x) - !$acc routine (subr1) ! { dg-error "invalid function name" } integer, intent(inout) :: x if (x < 1) then x = 1 @@ -66,7 +63,7 @@ subroutine subr2 (x) end subroutine subr2 subroutine subr3 (x) - !$acc routine (subr3) + !$acc routine (subr3) seq integer, intent(inout) :: x if (x < 1) then x = 1 @@ -76,7 +73,7 @@ subroutine subr3 (x) end subroutine subr3 subroutine subr4 (x) - !$acc routine (subr4) + !$acc routine (subr4) seq integer, intent(inout) :: x if (x < 1) then x = 1 @@ -86,7 +83,6 @@ subroutine subr4 (x) 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 diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 index c9039153885..beca43f2d60 100644 --- a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 @@ -4,7 +4,7 @@ program main interface function s_1 (a) integer a - !$acc routine + !$acc routine seq end function s_1 end interface @@ -18,7 +18,7 @@ program main interface function s_3 (a) integer a - !$acc routine (s_3) ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" } + !$acc routine (s_3) seq ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" } end function s_3 end interface diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 index 75dd1b01f6f..efc1b400add 100644 --- a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 @@ -7,7 +7,7 @@ subroutine g_1 end subroutine g_1 subroutine s_1_2a - !$acc routine + !$acc routine seq end subroutine s_1_2a subroutine s_1_2b @@ -15,7 +15,7 @@ subroutine s_1_2b end subroutine s_1_2b subroutine s_1_2c - !$acc routine (s_1_2c) + !$acc routine (s_1_2c) seq end subroutine s_1_2c subroutine s_1_2d @@ -25,7 +25,7 @@ end subroutine s_1_2d module s_2 contains subroutine s_2_1a - !$acc routine + !$acc routine seq end subroutine s_2_1a subroutine s_2_1b @@ -33,7 +33,7 @@ contains end subroutine s_2_1b subroutine s_2_1c - !$acc routine (s_2_1c) + !$acc routine (s_2_1c) seq end subroutine s_2_1c subroutine s_2_1d @@ -48,7 +48,7 @@ subroutine test interface function s_3_1a (a) integer a - !$acc routine + !$acc routine seq end function s_3_1a end interface diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 index ff0921863f6..4cdaa0c4d60 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 @@ -81,7 +81,7 @@ subroutine saxpy (nn, aa, xx, yy) integer :: nn real*4 :: aa, xx(nn), yy(nn) integer i - !$acc routine + !$acc routine seq do i = 1, nn yy(i) = yy(i) + aa * xx(i) diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f index 05ed949ee5c..fe0b904bb91 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f +++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f @@ -67,7 +67,7 @@ integer :: nn real*4 :: aa, xx(nn), yy(nn) integer i -!$acc routine +!$acc routine seq do i = 1, nn yy(i) = yy(i) + aa * xx(i) diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 index 6e379b5485b..e192c59a97c 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 @@ -21,7 +21,7 @@ contains integer :: nn real*4 :: aa, xx(nn), yy(nn) integer i - !$acc routine + !$acc routine seq do i = 1, nn yy(i) = yy(i) + aa * xx(i) diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 index 6a573218b7a..346e875ba00 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 @@ -3,7 +3,7 @@ interface recursive function fact (x) - !$acc routine + !$acc routine seq integer, intent(in) :: x integer :: fact end function fact @@ -21,7 +21,7 @@ end do end recursive function fact (x) result (res) - !$acc routine + !$acc routine seq integer, intent(in) :: x integer :: res if (x < 1) then diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 index b6979747902..1391979291c 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 @@ -4,7 +4,7 @@ module m1 contains recursive function fact (x) result (res) - !$acc routine + !$acc routine seq integer, intent(in) :: x integer :: res if (x < 1) then diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 index e7b9d8ab364..6f49db97b80 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 @@ -4,7 +4,7 @@ integer, parameter :: n = 10 integer :: a(n), i integer, external :: fact - !$acc routine (fact) + !$acc routine (fact) seq !$acc parallel !$acc loop do i = 1, n @@ -16,7 +16,7 @@ end do end recursive function fact (x) result (res) - !$acc routine + !$acc routine seq integer, intent(in) :: x integer :: res if (x < 1) then diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 index a96363b8cde..85bdb2a0a07 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 @@ -17,7 +17,7 @@ end do end subroutine incr (x) - !$acc routine + !$acc routine seq integer, intent(inout) :: x x = x + 1 end subroutine incr diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 index a803ad96bb5..88d65741b7c 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 @@ -15,7 +15,7 @@ program main contains function func (n) result (rc) - !$acc routine + !$acc routine seq integer, intent (in) :: n integer :: rc diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 index f58a95fe670..a83e92ab129 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 @@ -1,4 +1,3 @@ - ! { dg-do run } ! { dg-additional-options "-cpp" } @@ -100,7 +99,7 @@ subroutine gang (a) integer, intent (inout) :: a(N) integer :: i - !$acc loop gang + !$acc loop gang worker vector do i = 1, N a(i) = a(i) - i end do diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 index b1a1338dd8c..4a1250405cb 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 @@ -6,7 +6,7 @@ program main integer, parameter :: n = 10 integer :: a(n), i integer, external :: fact - !$acc routine (fact) + !$acc routine (fact) seq !$acc parallel !$acc loop do i = 1, n @@ -20,7 +20,7 @@ end program main recursive function fact (x) result (res) implicit none - !$acc routine (fact) + !$acc routine (fact) seq integer, intent(in) :: x integer :: res if (x < 1) then -- 2.17.1