[fortran] Unify / fix error messages for matmul

Message ID	52d026ff-fcf7-335a-84bb-68f25ae728e8@netcologne.de
State	New
Headers	show Return-Path: <gcc-patches-return-485720-incoming=patchwork.ozlabs.org@gcc.gnu.org> DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=tOzFqJ9WtSy9NbA0Z8f334ISOvomc5qVbgpP/T2waFQtLb8Bpt Tvs6lD1VTX+uvnMJgnjBhmimdIbGLcF274nJ0WpWlSn7jTl0q4xt6ZL4boGl5dC2 wraNIWqHe2B10EZC8LluRESU1Op5ccpiFS0HU1Y3dWYef+ks+ycwgiVhs= Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org To: "fortran@gcc.gnu.org" <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org> From: Thomas Koenig <tkoenig@netcologne.de> Subject: [patch, fortran] Unify / fix error messages for matmul Message-ID: <52d026ff-fcf7-335a-84bb-68f25ae728e8@netcologne.de> Date: Sun, 16 Sep 2018 17:54:24 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.9.1 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------C8022E21DFE40969B1FCB03A"
Series	[fortran] Unify / fix error messages for matmul \| expand [fortran] Unify / fix error messages for matmul

Index: gcc/fortran/frontend-passes.c =================================================================== --- gcc/fortran/frontend-passes.c (Revision 263838) +++ gcc/fortran/frontend-passes.c (Arbeitskopie) @@ -3748,6 +3748,15 @@ check_conjg_transpose_variable (gfc_expr *e, bool return NULL; } +/* Macros for unified error messages. */ + +#define B_ERROR(n) _("Incorrect extent in argument B in MATMUL intrinsic in " \ + "dimension " #n ": is %ld, should be %ld") + +#define C_ERROR(n) _("Array bound mismatch for dimension " #n " of array " \ + "(%ld/%ld)") + + /* Inline assignments of the form c = matmul(a,b). Handle only the cases currently where b and c are rank-two arrays. @@ -3793,6 +3802,7 @@ inline_matmul_assign (gfc_code **c, int *walk_subt gfc_code *if_limit = NULL; gfc_code **next_code_point; bool conjg_a, conjg_b, transpose_a, transpose_b; + bool realloc_c; if (co->op != EXEC_ASSIGN) return 0; @@ -3958,169 +3968,139 @@ inline_matmul_assign (gfc_code **c, int *walk_subt assign_zero->expr1->no_bounds_check = 1; assign_zero->expr2 = zero_e; - /* Handle the reallocation, if needed. */ - if (flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1)) + realloc_c = flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1); + + if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) { - gfc_code *lhs_alloc; + gfc_code *test; + gfc_expr *a2, *b1, *c1, *c2, *a1, *b2; - /* Only need to check a single dimension for the A2B2 case for - bounds checking, the rest will be allocated. Also check this - for A2B1. */ - - if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) + switch (m_case) { - gfc_code *test; - if (m_case == A2B2 || m_case == A2B1) - { - gfc_expr *a2, *b1; + case A2B1: - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); - b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a2, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; - } - else if (m_case == A1B2) + b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); + a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + test = runtime_error_ne (b1, a2, B_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; + + if (!realloc_c) { - gfc_expr *a1, *b1; - + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); - b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a1, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); + test = runtime_error_ne (c1, a1, C_ERROR(1)); *next_code_point = test; next_code_point = &test->next; } - } + break; - lhs_alloc = matmul_lhs_realloc (expr1, matrix_a, matrix_b, m_case); + case A1B2: - *next_code_point = lhs_alloc; - next_code_point = &lhs_alloc->next; - - } - else if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) - { - gfc_code *test; - gfc_expr *a2, *b1, *c1, *c2, *a1, *b2; - - if (m_case == A2B2 || m_case == A2B1) - { - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a2, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); + 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; - c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); - a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + if (!realloc_c) + { + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); + b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + test = runtime_error_ne (c1, b2, C_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; + } + break; - if (m_case == A2B2) - test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 1: " - "is %ld, should be %ld"); - else if (m_case == A2B1) - test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " - "MATMUL intrinsic: " - "is %ld, should be %ld"); + case A2B2: - - *next_code_point = test; - next_code_point = &test->next; - } - else if (m_case == A1B2) - { - a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a1, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); + a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + test = runtime_error_ne (b1, a2, B_ERROR(1)); *next_code_point = test; next_code_point = &test->next; - c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); - b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + if (!realloc_c) + { + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); + a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + test = runtime_error_ne (c1, a1, C_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; - test = runtime_error_ne (c1, b2, "Incorrect extent in return array in " - "MATMUL intrinsic: " - "is %ld, should be %ld"); + c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); + b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + test = runtime_error_ne (c2, b2, C_ERROR(2)); + *next_code_point = test; + next_code_point = &test->next; + } + break; - *next_code_point = test; - next_code_point = &test->next; - } + case A2B2T: - if (m_case == A2B2) - { - c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); - test = runtime_error_ne (c2, b2, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 2: is %ld, should be %ld"); - + a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + test = runtime_error_ne (b2, a2, B_ERROR(2)); *next_code_point = test; next_code_point = &test->next; - } - if (m_case == A2B2T) - { - c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); - a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); - test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 1: " - "is %ld, should be %ld"); + if (!realloc_c) + { + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); + a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + test = runtime_error_ne (c1, a1, C_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; - *next_code_point = test; - next_code_point = &test->next; + c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); + b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); + test = runtime_error_ne (c2, b1, C_ERROR(2)); + *next_code_point = test; + next_code_point = &test->next; + } + break; - c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); + case A2TB2: + b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (c2, b1, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 2: " - "is %ld, should be %ld"); + 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; - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); - b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + 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; - test = runtime_error_ne (b2, a2, "Incorrect extent in argument B in " - "MATMUL intrnisic for dimension 2: " - "is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; + c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); + b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + test = runtime_error_ne (c2, b2, C_ERROR(2)); + *next_code_point = test; + next_code_point = &test->next; + } + break; + default: + gcc_unreachable (); } + } - if (m_case == A2TB2) - { - c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + /* Handle the reallocation, if needed. */ - test = runtime_error_ne (c1, a2, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 1: " - "is %ld, should be %ld"); + if (realloc_c) + { + gfc_code *lhs_alloc; - *next_code_point = test; - next_code_point = &test->next; + lhs_alloc = matmul_lhs_realloc (expr1, matrix_a, matrix_b, m_case); - c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); - b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); - test = runtime_error_ne (c2, b2, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 2: " - "is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; + *next_code_point = lhs_alloc; + next_code_point = &lhs_alloc->next; - a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); - b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - - test = runtime_error_ne (b1, a1, "Incorrect extent in argument B in " - "MATMUL intrnisic for dimension 2: " - "is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; - - } } *next_code_point = assign_zero; Index: gcc/testsuite/gfortran.dg/inline_matmul_15.f90 =================================================================== --- gcc/testsuite/gfortran.dg/inline_matmul_15.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/inline_matmul_15.f90 (Arbeitskopie) @@ -9,4 +9,4 @@ program main call random_number(b) print *,matmul(a,b) end program main -! { dg-output "Fortran runtime error: Dimension of array B incorrect in MATMUL intrinsic.*" } +! { dg-output "Fortran runtime error: Incorrect extent in argument B in MATMUL intrinsic in dimension 1" } Index: gcc/testsuite/gfortran.dg/matmul_5.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_5.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_5.f90 (Arbeitskopie) @@ -9,4 +9,4 @@ program main call random_number(b) print *,matmul(a,b) end program main -! { dg-output "Fortran runtime error: dimension of array B incorrect in MATMUL intrinsic.*" } +! { dg-output "Fortran runtime error: Incorrect extent in argument B in MATMUL intrinsic in dimension 1" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_10.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_10.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_10.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(4,3)) ret = matmul(a,transpose(b)) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 4, should be 3" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array.*" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_11.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_11.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_11.f90 (Arbeitskopie) @@ -11,5 +11,5 @@ program main res = matmul(a,b) print *,res end program main -! { dg-output "Fortran runtime error: Dimension of array B incorrect in MATMUL intrinsic.*" } +! { dg-output "Fortran runtime error: Incorrect extent in argument B in MATMUL intrinsic in dimension 1: is 3, should be 2" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(3,2)) ret = matmul(a,b) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 2 of array.*" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(2,3)) ret = matmul(a,b) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 2, should be 3" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(3)) ret = matmul(a,b) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(3)) ret = matmul(a,b) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_8.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_8.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_8.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(3,2)) ret = matmul(a,transpose(b)) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 2 of array" } Index: libgfortran/generated/matmul_c10.c =================================================================== --- libgfortran/generated/matmul_c10.c (Revision 263856) +++ libgfortran/generated/matmul_c10.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_c10 (gfc_array_c10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_c10 (gfc_array_c10 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_c10 (gfc_array_c10 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_c16.c =================================================================== --- libgfortran/generated/matmul_c16.c (Revision 263856) +++ libgfortran/generated/matmul_c16.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_c16 (gfc_array_c16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_c16 (gfc_array_c16 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_c16 (gfc_array_c16 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_c4.c =================================================================== --- libgfortran/generated/matmul_c4.c (Revision 263856) +++ libgfortran/generated/matmul_c4.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_c8.c =================================================================== --- libgfortran/generated/matmul_c8.c (Revision 263856) +++ libgfortran/generated/matmul_c8.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i1.c =================================================================== --- libgfortran/generated/matmul_i1.c (Revision 263856) +++ libgfortran/generated/matmul_i1.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i16.c =================================================================== --- libgfortran/generated/matmul_i16.c (Revision 263856) +++ libgfortran/generated/matmul_i16.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i16 (gfc_array_i16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i16 (gfc_array_i16 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i16 (gfc_array_i16 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i2.c =================================================================== --- libgfortran/generated/matmul_i2.c (Revision 263856) +++ libgfortran/generated/matmul_i2.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i4.c =================================================================== --- libgfortran/generated/matmul_i4.c (Revision 263856) +++ libgfortran/generated/matmul_i4.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i8.c =================================================================== --- libgfortran/generated/matmul_i8.c (Revision 263856) +++ libgfortran/generated/matmul_i8.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_r10.c =================================================================== --- libgfortran/generated/matmul_r10.c (Revision 263856) +++ libgfortran/generated/matmul_r10.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_r10 (gfc_array_r10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_r10 (gfc_array_r10 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_r10 (gfc_array_r10 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_r16.c =================================================================== --- libgfortran/generated/matmul_r16.c (Revision 263856) +++ libgfortran/generated/matmul_r16.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_r16 (gfc_array_r16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_r16 (gfc_array_r16 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_r16 (gfc_array_r16 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_r4.c =================================================================== --- libgfortran/generated/matmul_r4.c (Revision 263856) +++ libgfortran/generated/matmul_r4.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_r8.c =================================================================== --- libgfortran/generated/matmul_r8.c (Revision 263856) +++ libgfortran/generated/matmul_r8.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_c10.c =================================================================== --- libgfortran/generated/matmulavx128_c10.c (Revision 263856) +++ libgfortran/generated/matmulavx128_c10.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_c16.c =================================================================== --- libgfortran/generated/matmulavx128_c16.c (Revision 263856) +++ libgfortran/generated/matmulavx128_c16.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_c4.c =================================================================== --- libgfortran/generated/matmulavx128_c4.c (Revision 263856) +++ libgfortran/generated/matmulavx128_c4.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_c8.c =================================================================== --- libgfortran/generated/matmulavx128_c8.c (Revision 263856) +++ libgfortran/generated/matmulavx128_c8.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i1.c =================================================================== --- libgfortran/generated/matmulavx128_i1.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i1.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i16.c =================================================================== --- libgfortran/generated/matmulavx128_i16.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i16.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i2.c =================================================================== --- libgfortran/generated/matmulavx128_i2.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i2.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i4.c =================================================================== --- libgfortran/generated/matmulavx128_i4.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i4.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i8.c =================================================================== --- libgfortran/generated/matmulavx128_i8.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i8.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_r10.c =================================================================== --- libgfortran/generated/matmulavx128_r10.c (Revision 263856) +++ libgfortran/generated/matmulavx128_r10.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_r16.c =================================================================== --- libgfortran/generated/matmulavx128_r16.c (Revision 263856) +++ libgfortran/generated/matmulavx128_r16.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_r4.c =================================================================== --- libgfortran/generated/matmulavx128_r4.c (Revision 263856) +++ libgfortran/generated/matmulavx128_r4.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_r8.c =================================================================== --- libgfortran/generated/matmulavx128_r8.c (Revision 263856) +++ libgfortran/generated/matmulavx128_r8.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/m4/matmul_internal.m4 =================================================================== --- libgfortran/m4/matmul_internal.m4 (Revision 263856) +++ libgfortran/m4/matmul_internal.m4 (Arbeitskopie) @@ -59,8 +59,8 @@ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -68,8 +68,8 @@ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -77,17 +77,15 @@ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -129,7 +127,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -174,7 +174,18 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return;

[fortran] Unify / fix error messages for matmul

Commit Message

Comments

Patch