[patch, fortran] Inline MATMUL(TRANSPOSE(A),B) for rank 1 B.
Thomas Koenig <[email protected]> Sat, 1 Aug 2026 10:48:53 +0200
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <[email protected]> |
Hello world, what it says in the ChangeLog. Regression-tested. OK for trunk? Best regards Thomas Inline MATMUL(TRANSPOSE(A),B) for rank 1 B. This patch implements inlining MATMUL(TRANSPOSE(A),B). For ordering of the loops, this is an unpleasant problem because of the dependence of c(i) on the previous iteration, but gcc was able to fully unroll the loops at least for small sizes, and the version in the patch generated better code. gcc/fortran/ChangeLog: * frontend-passes.cc (enum matrix_case): Add case A2TB1. (matmul_lhs_realloc): Add condition for reallocation and size checks. (inline_matmul_assign): Handle A2TB1. gcc/testsuite/ChangeLog: * gfortran.dg/inline_matmul_29.f90: New test.
p-a2tb1.diff
(text/x-patch, 4 KB)
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index 70e8ec9e161..c03cd093bb4 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -133,7 +133,7 @@ static int var_num = 1;
/* What sort of matrix we are dealing with when inlining MATMUL. */
-enum matrix_case { none=0, A2B2, A2B1, A1B2, A2B2T, A2TB2, A2TB2T };
+enum matrix_case { none=0, A2B2, A2B1, A1B2, A2B2T, A2TB2, A2TB2T, A2TB1 };
/* Keep track of the number of expressions we have inserted so far
using create_var. */
@@ -3569,6 +3569,13 @@ matmul_lhs_realloc (gfc_expr *c, gfc_expr *a, gfc_expr *b,
get_array_inq_function (GFC_ISYM_SIZE, a, 1));
break;
+ case A2TB1:
+ ar->start[0] = get_array_inq_function (GFC_ISYM_SIZE, a, 2);
+ cond = build_logical_expr (INTRINSIC_NE,
+ get_array_inq_function (GFC_ISYM_SIZE, c, 1),
+ get_array_inq_function (GFC_ISYM_SIZE, a, 2));
+ break;
+
case A1B2:
ar->start[0] = get_array_inq_function (GFC_ISYM_SIZE, b, 2);
cond = build_logical_expr (INTRINSIC_NE,
@@ -4219,6 +4226,8 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
{
if (matrix_b->rank == 2 && !transpose_b)
m_case = A2TB2;
+ else if (matrix_b->rank == 1)
+ m_case = A2TB1;
}
else
{
@@ -4373,6 +4382,23 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
}
break;
+ case A2TB1:
+ b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
+ a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
+ test = runtime_error_ne (b1, a1, B_ERROR_1);
+ *next_code_point = test;
+ next_code_point = &test->next;
+
+ if (!realloc_c)
+ {
+ c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
+ a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
+ test = runtime_error_ne (c1, a2, C_ERROR_1);
+ *next_code_point = test;
+ next_code_point = &test->next;
+ }
+ break;
+
case A1B2:
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
@@ -4616,6 +4642,40 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
break;
+ case A2TB1:
+
+ /* Ordering here is
+ do i=1,size(a,2)
+ do j=1,size(b,1)
+ c(i) = c(i) + a(j,i) * b(j)
+ end do
+ end do
+ where i is var_1 and j is var_2. */
+
+ u1 = get_size_m1 (matrix_a, 2);
+ u2 = get_size_m1 (matrix_b, 1);
+
+ do_1 = create_do_loop (gfc_copy_expr (zero), u1, NULL, &co->loc, ns);
+ do_2 = create_do_loop (gfc_copy_expr (zero), u2, NULL, &co->loc, ns);
+
+ do_1->block->next = do_2;
+ do_2->block->next = assign_matmul;
+
+ var_1 = do_1->ext.iterator->var;
+ var_2 = do_2->ext.iterator->var;
+
+ list[0] = var_1;
+ cscalar = scalarized_expr (co->expr1, list, 1);
+
+ list[0] = var_2;
+ list[1] = var_1;
+ ascalar = scalarized_expr (matrix_a, list, 2);
+
+ list[0] = var_2;
+ bscalar = scalarized_expr (matrix_b, list, 1);
+
+ break;
+
case A1B2:
u1 = get_size_m1 (matrix_b, 2);
u2 = get_size_m1 (matrix_a, 1);
diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_29.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_29.f90
new file mode 100644
index 00000000000..9372a0524d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inline_matmul_29.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-additional-options "-ffrontend-optimize -fdump-tree-original" }
+
+PROGRAM memain
+ implicit none
+ REAL(8), DIMENSION(3) :: b
+ REAL(8), DIMENSION(3,2) :: A
+ real(8), dimension(:), allocatable :: y
+ real(8), dimension(2) :: z
+ integer :: i, j
+
+ A(:,1) = [1,-2,3]
+ A(:,2) = [-4,5,6]
+
+ b = [7,-8,9]
+ y = matmul(transpose(A),b)
+ z = 0
+ do i=1,2
+ do j=1,3
+ z(i) = z(i) + a(j,i) * b(j)
+ end do
+ end do
+ if (size(z,1) /= size(y,1)) stop 1
+ if (any(abs(z - y) > 1e-12)) stop 2
+
+END PROGRAM memain
+! { dg-final { scan-tree-dump-not "_gfortran_matmul_r8" "original" } }
+! { dg-final { scan-tree-dump-not "_gfortran_transpose_r8" "original" } }