[gcc r17-2877] Inline MATMUL(TRANSPOSE(A),B) for rank 1 B.

https://gcc.gnu.org/g:f0241f047bb0858964119e3aaad2bbd61e7d757f

commit r17-2877-gf0241f047bb0858964119e3aaad2bbd61e7d757f
Author: Thomas Koenig <[email protected]>
Date:   Sat Aug 1 10:47:27 2026 +0200

    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.

Diff:
---
 gcc/fortran/frontend-passes.cc                 | 62 +++++++++++++++++++++++++-
 gcc/testsuite/gfortran.dg/inline_matmul_29.f90 | 28 ++++++++++++
 2 files changed, 89 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index 8abe07e8f59f..f32d055c0619 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.  */
@@ -3572,6 +3572,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,
@@ -4222,6 +4229,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
 	{
@@ -4376,6 +4385,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);
@@ -4619,6 +4645,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 000000000000..9372a0524d4b
--- /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" } }