Re: [openacc] Teach gfortran to lower OpenACC routine dims

[Cesar Philippidis <cesar@codesourcery.com>]

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