[openacc] Teach gfortran to lower OpenACC routine dims
Bernhard Reutner-Fischer
rep.dot.nop@gmail.com
Wed Sep 19 22:30:00 GMT 2018
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,
More information about the Gcc-patches
mailing list