[patch, fortran, RFC] Interchange indices for FORALL and DO CONCURRENT if profitable

[Steve Kargl]

Hi Thomas,

In general, I like the idea.  I have some minor suggestions below.


On Sat, Oct 28, 2017 at 12:03:58AM +0200, Thomas Koenig wrote:
> +/* Callback function to determine if an expression is the 
> +   corresponding variable.  */
> +
> +static int

static bool

> +has_var (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, void *data)
> +{
> +  gfc_expr *expr = *e;
> +  gfc_symbol *sym;
> +
> +  if (expr->expr_type != EXPR_VARIABLE)
> +    return 0;

return false;

> +
> +  sym = (gfc_symbol *) data;
> +  return sym == expr->symtree->n.sym;
> +}
> +
> +/* Callback function to calculate the cost of a certain index.  */

This function always returns 0, so

> +static int

static void

> +index_cost (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
> +	    void *data)
> +{
> +  ind_type *ind;
> +  gfc_expr *expr;
> +  gfc_array_ref *ar;
> +  gfc_ref *ref;
> +  int i,j;
> +
> +  expr = *e;
> +  if (expr->expr_type != EXPR_VARIABLE)
> +    return 0;

return;

> +
> +  ar = NULL;
> +  for (ref = expr->ref; ref; ref = ref->next)
> +    {
> +      if (ref->type == REF_ARRAY)
> +	{
> +	  ar = &ref->u.ar;
> +	  break;
> +	}
> +    }
> +  if (ar == NULL || ar->type != AR_ELEMENT)
> +    return 0;

return;

> +
> +  ind = (ind_type *) data;
> +  for (i = 0; i < ar->dimen; i++)
> +    {
> +      for (j=0; ind[j].sym != NULL; j++)
> +	{
> +	  if (gfc_expr_walker (&ar->start[i], has_var, (void *) (ind[j].sym)))
> +	      ind[j].n[i]++;
> +	}
> +    }
> +  return 0;

Delete this return as a void function that reaches its
end will return;

> +}
> +
> +/* Callback function for qsort, to sort the loop indices. */
> +
> +static int
> +loop_comp (const void *e1, const void *e2)
> +{
> +  const ind_type *i1 = (const ind_type *) e1;
> +  const ind_type *i2 = (const ind_type *) e2;
> +  int i;
> +
> +  for (i=GFC_MAX_DIMENSIONS-1; i >= 0; i--)
> +    {
> +      if (i1->n[i] != i2->n[i])
> +	return i1->n[i] - i2->n[i];
> +    }
> +  /* All other things being equal, let's not change the ordering.  */
> +  return i2->num - i1->num;
> +}
> +
> +/* Main function to do the index interchange.  */
> +

This function always returns 0, so

> +static int

static void

> +index_interchange (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
> +		  void *data ATTRIBUTE_UNUSED)
> +{
> +  gfc_code *co;
> +  co = *c;
> +  int n_iter;
> +  gfc_forall_iterator *fa;
> +  ind_type *ind;
> +  int i, j;
> +  
> +  if (co->op != EXEC_FORALL && co->op != EXEC_DO_CONCURRENT)
> +    return 0;

return;

> +
> +  n_iter = 0;
> +  for (fa = co->ext.forall_iterator; fa; fa = fa->next)
> +    n_iter ++;
> +
> +  /* Nothing to reorder. */
> +  if (n_iter < 2)
> +    return 0;

return;

> +
> +  ind = XALLOCAVEC (ind_type, n_iter + 1);
> +
> +  i = 0;
> +  for (fa = co->ext.forall_iterator; fa; fa = fa->next)
> +    {
> +      ind[i].sym = fa->var->symtree->n.sym;
> +      ind[i].fa = fa;
> +      for (j=0; j<GFC_MAX_DIMENSIONS; j++)
> +	ind[i].n[j] = 0;
> +      ind[i].num = i;
> +      i++;
> +    }
> +  ind[n_iter].sym = NULL;
> +  ind[n_iter].fa = NULL;
> +
> +  gfc_code_walker (c, gfc_dummy_code_callback, index_cost, (void *) ind);
> +  qsort ((void *) ind, n_iter, sizeof (ind_type), loop_comp);
> +
> +  /* Do the actual index interchange.  */
> +  co->ext.forall_iterator = fa = ind[0].fa;
> +  for (i=1; i<n_iter; i++)
> +    {
> +      fa->next = ind[i].fa;
> +      fa = fa->next;
> +    }
> +  fa->next = NULL;
> +
> +  return 0;

Delete this return.

-- 
Steve