+2017-05-29 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/37131
+ * frontend-passes.c (check_conjg_transpose_variable):
+ Add prototype.
+ (has_dimen_vector_ref): Likewise
+ (matmul_temp_args): New function. Add prototype.
+ (optimize_namespace): Call matmul_temp_args.
+
2017-05-28 Thomas Koenig <tkoenig@gcc.gnu.org>
* frontend-passes.c (matmul_lhs_realloc): Correct
static gfc_code * create_do_loop (gfc_expr *, gfc_expr *, gfc_expr *,
locus *, gfc_namespace *,
char *vname=NULL);
+static gfc_expr* check_conjg_transpose_variable (gfc_expr *, bool *,
+ bool *);
+static bool has_dimen_vector_ref (gfc_expr *);
+static int matmul_temp_args (gfc_code **, int *,void *data);
#ifdef CHECKING_P
static void check_locus (gfc_namespace *);
(void *) &found);
}
while (found);
-
+
+ gfc_code_walker (&ns->code, matmul_temp_args, dummy_expr_callback,
+ NULL);
gfc_code_walker (&ns->code, inline_matmul_assign, dummy_expr_callback,
NULL);
}
-
+
/* BLOCKs are handled in the expression walker below. */
for (ns = ns->contained; ns; ns = ns->sibling)
{
}
+/* Take a statement of the shape c = matmul(a,b) and create temporaries
+ for a and b if there is a dependency between the arguments and the
+ result variable or if a or b are the result of calculations that cannot
+ be handled by the inliner. */
+
+static int
+matmul_temp_args (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_expr *expr1, *expr2;
+ gfc_code *co;
+ gfc_actual_arglist *a, *b;
+ bool a_tmp, b_tmp;
+ gfc_expr *matrix_a, *matrix_b;
+ bool conjg_a, conjg_b, transpose_a, transpose_b;
+
+ co = *c;
+
+ if (co->op != EXEC_ASSIGN)
+ return 0;
+
+ if (forall_level > 0 || iterator_level > 0 || in_omp_workshare
+ || in_where)
+ return 0;
+
+ /* This has some duplication with inline_matmul_assign. This
+ is because the creation of temporary variables could still fail,
+ and inline_matmul_assign still needs to be able to handle these
+ cases. */
+ expr1 = co->expr1;
+ expr2 = co->expr2;
+
+ if (expr2->expr_type != EXPR_FUNCTION
+ || expr2->value.function.isym == NULL
+ || expr2->value.function.isym->id != GFC_ISYM_MATMUL)
+ return 0;
+
+ a_tmp = false;
+ a = expr2->value.function.actual;
+ matrix_a = check_conjg_transpose_variable (a->expr, &conjg_a, &transpose_a);
+ if (matrix_a != NULL)
+ {
+ if (matrix_a->expr_type == EXPR_VARIABLE
+ && (gfc_check_dependency (matrix_a, expr1, true)
+ || has_dimen_vector_ref (matrix_a)))
+ a_tmp = true;
+ }
+ else
+ a_tmp = true;
+
+ b_tmp = false;
+ b = a->next;
+ matrix_b = check_conjg_transpose_variable (b->expr, &conjg_b, &transpose_b);
+ if (matrix_b != NULL)
+ {
+ if (matrix_b->expr_type == EXPR_VARIABLE
+ && (gfc_check_dependency (matrix_b, expr1, true)
+ || has_dimen_vector_ref (matrix_b)))
+ b_tmp = true;
+ }
+ else
+ b_tmp = true;
+
+ if (!a_tmp && !b_tmp)
+ return 0;
+
+ current_code = c;
+ inserted_block = NULL;
+ changed_statement = NULL;
+ if (a_tmp)
+ {
+ gfc_expr *at;
+ at = create_var (a->expr,"mma");
+ if (at)
+ a->expr = at;
+ }
+ if (b_tmp)
+ {
+ gfc_expr *bt;
+ bt = create_var (b->expr,"mmb");
+ if (bt)
+ b->expr = bt;
+ }
+ return 0;
+}
+
/* Auxiliary function to build and simplify an array inquiry function.
dim is zero-based. */
+2017-05-29 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/37131
+ * gfortran.dg/promotion_2.f90: Add -finline-matmul-limit=0 to
+ flags.
+ * gfortran.dg/transpose_optimization_1.f90: Likewise.
+ * gfortran.dg/inline_matmul_17.f90: New test.
+
2017-05-28 Thomas Koenig <tkoenig@gcc.gnu.org>
* gfortran.dg/matmul_bounds_12.f90: New test.
--- /dev/null
+! { dg-do run }
+! { dg-options "-O -fdump-tree-optimized -finline-matmul-limit=1000" }
+module x
+ implicit none
+contains
+ function afunc()
+ real, dimension(3,3) :: afunc
+ afunc = reshape([ 2., 3., 5., 7., 11., 13., 17., 19., 23. ], [3,3])
+ end function afunc
+
+ function bfunc()
+ real, dimension(3,3) :: bfunc
+ bfunc = reshape([29., 31., 37., 41., 43., 47., 53., 59., 61., 67.],[3,3])
+ end function bfunc
+end module x
+
+program main
+ use x
+ implicit none
+ real, dimension(3,3), parameter :: &
+ & aval = reshape([ 2., 3., 5., 7., 11., 13., 17., 19., 23. ], [3,3]), &
+ & bval = reshape([29., 31., 37., 41., 43., 47., 53., 59., 61., 67.],[3,3])
+ integer, dimension(3) :: ind
+ real, dimension(3,3) :: a, b,c,d, ri
+ data ri /120430., 187861., 151737., 161022., 251139., 202847., 212566., 331537., 267781./
+ data d/904., 1131., 1399., 1182., 1489., 1845., 1556., 1967., 2435. /
+ a = aval
+ b = bval
+ c = matmul(a,b)
+ a = matmul(a,b)
+ if (any(a-c /= 0)) call abort
+ a = aval
+ b = bval
+ b = matmul(a,b)
+ if (any(b-c /= 0)) call abort
+ b = bval
+ a = matmul(aval, b)
+ if (any(a-c /= 0)) call abort
+ ind = [1, 3, 2]
+ c = matmul(a(ind,:),b)
+ if (any(c-ri /= 0)) call abort
+ c = matmul(afunc(),b)
+ if (any(c-d /= 0)) call abort
+ a = afunc()
+ c = matmul(a, bfunc())
+ if (any(c-d /= 0)) call abort
+end program main
+! { dg-final { scan-tree-dump-times "matmul_r4" 2 "optimized" } }
! { dg-do compile }
-! { dg-options "-fdefault-real-8 -fexternal-blas -fdump-tree-original" }
+! { dg-options "-fdefault-real-8 -fexternal-blas -fdump-tree-original -finline-matmul-limit=0" }
!
! PR fortran/54463
!
! { dg-do compile }
-! { dg-options "-Warray-temporaries -fdump-tree-original" }
+! { dg-options "-Warray-temporaries -fdump-tree-original -finline-matmul-limit=0" }
!
! PR fortran/45648
! Non-copying descriptor transpose optimization (for function call args).
projects / platform / upstream / gcc.git / commitdiff