Le 01/01/2013 21:18, Thomas Koenig a écrit :
Hello world,
the attached patch replaces ANY(a, b, c) with a .or. b .or c,
leading to reduced execution time. It also handles ALL, PRODUCT
and SUM.
This fixes a bug noted by Michael Metcalf.
Regression-tested. OK for trunk?
A few comments below.
Mikael
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 194760)
+++ frontend-passes.c (Arbeitskopie)
@@ -180,7 +183,172 @@ optimize_expr (gfc_expr **e, int *walk_subtrees AT
return 0;
}
+/* Auxiliary function to handle the arguments to reduction intrnisics.
+ If the function is a scalar, just copy it; otherwise Returns the new
+ element, the old one can be freed. */
+static gfc_expr *
+copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn)
+{
+ gfc_expr *fcn;
+ const char *new_name;
+ gfc_actual_arglist *actual_arglist;
+
+ if (e->rank == 0 || e->expr_type == EXPR_FUNCTION)
+ fcn = gfc_copy_expr (e);
+ else
+ {
+ fcn = gfc_get_expr ();
+ fcn->expr_type = EXPR_FUNCTION;
+ fcn->value.function.isym = fn->value.function.isym;
+ actual_arglist = gfc_get_actual_arglist ();
+ actual_arglist->expr = gfc_copy_expr (e);
+ actual_arglist->next = gfc_get_actual_arglist ();
Another one is needed. I get a segmentation fault with SUM.
[...]
+
+/* Callback function for optimzation of reductions to scalars. Transform
+ ANY ([f1,f2,f3, ...]) to f1 .or. f2 .or. f3 .or. ..., with ANY,
+ SUM and PRODUCT correspondingly. Handly only the simple cases without
+ MASK and DIM. */
+
+static int
+callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_expr *fn, *arg;
+ gfc_intrinsic_op op;
+ gfc_isym_id id;
+ gfc_actual_arglist *a;
+ gfc_actual_arglist *dim;
+ gfc_constructor *c;
+ gfc_expr *res, *new_expr;
+
+ fn = *e;
+
+ if (fn->rank != 0 || fn->expr_type != EXPR_FUNCTION
+ || fn->value.function.isym == NULL)
+ return 0;
+
+ id = fn->value.function.isym->id;
+
+ if (id != GFC_ISYM_SUM && id != GFC_ISYM_PRODUCT
+ && id != GFC_ISYM_ANY && id != GFC_ISYM_ALL)
+ return 0;
+
+ a = fn->value.function.actual;
+
+ /* Don't handle MASK or DIM. */
+
+ dim = a->next;
+
+ if (dim != NULL)
+ {
Minor, but I think you can assume dim != NULL. Same for mask.
+ gfc_actual_arglist *mask;
+
+ if (dim->expr != NULL)
+ return 0;
+
+ mask = dim->next;
+ if (mask != NULL)
+ if ( mask->expr != NULL)
+ return 0;
+ }
+
+ arg = a->expr;
+
+ if (arg->expr_type != EXPR_ARRAY)
+ return 0;
+
+ switch (id)
+ {
+ case GFC_ISYM_SUM:
+ op = INTRINSIC_PLUS;
+ break;
+
+ case GFC_ISYM_PRODUCT:
+ op = INTRINSIC_TIMES;
+ break;
+
+ case GFC_ISYM_ANY:
+ op = INTRINSIC_OR;
+ break;
+
+ case GFC_ISYM_ALL:
+ op = INTRINSIC_AND;
+ break;
+
+ default:
+ return 0;
+ }
+
+ c = gfc_constructor_first (arg->value.constructor);
+
+ if (c == NULL)
+ return 0;
+
+ res = copy_walk_reduction_arg (c->expr, fn);
+
+ c = gfc_constructor_next (c);
+ while (c)
+ {
+ new_expr = gfc_get_expr ();
+ new_expr->ts = fn->ts;
+ new_expr->expr_type = EXPR_OP;
+ new_expr->rank = fn->rank;
+ new_expr->where = fn->where;
+ new_expr->value.op.op = op;
+ new_expr->value.op.op1 = res;
+ new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
+ res = new_expr;
+ c = gfc_constructor_next (c);
+ }
+
+ gfc_simplify_expr (res, 0);
+ *e = res;
+ gfc_free_expr (fn);
+
+ /* We changed things from under the expression walker. Walking the
+ old tree would mess up things, so let's not do that. */
+ return 1;
I think this prevents any further reduction optimization. The following
variant of your test case doesn't avoid the temporary:
do i=1,3
if (any([abs(a(i,1) - b(i,1)) > acc, &
(j==i+1,j=3,8)])) cycle
if (any([abs(a(i,2) - b(i,2)) > acc, &
abs(a(i,3) - b(i,3)) > acc, lo(i,:)])) cycle
c = c + i
end do
