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
