Skip to content

R
riscv-gcc-1
Commit ed33417a by Thomas Koenig
Options

re PR fortran/37802 (Improve wording for matmul bound checking) 

2018-09-16  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37802
	* frontend-passes.c (B_ERROR): New macro for matmul bounds
	checking error messages.
	(C_ERROR): Likewise.
	(inline_matmul_assign): Reorganize bounds checking, use B_ERROR
	and C_ERROR macros.

2018-09-16  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37802
	* gfortran.dg/matmul_bounds_13.f90: New test case.
	* gfortran.dg/inline_matmul_15.f90:  Adjust test for runtime
	error.
	* gfortran.dg/matmul_5.f90: Likewise.
	* gfortran.dg/matmul_bounds_10.f90: Likewise.
	* gfortran.dg/matmul_bounds_11.f90: Likewise.
	* gfortran.dg/matmul_bounds_2.f90: Likewise.
	* gfortran.dg/matmul_bounds_4.f90: Likewise.
	* gfortran.dg/matmul_bounds_5.f90: Likewise.

2018-09-16  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37802
	* m4/matmul_internal.m4: Adjust error messages.
        * generated/matmul_c10.c: Regenerated.
        * generated/matmul_c16.c: Regenerated.
        * generated/matmul_c4.c: Regenerated.
        * generated/matmul_c8.c: Regenerated.
        * generated/matmul_i1.c: Regenerated.
        * generated/matmul_i16.c: Regenerated.
        * generated/matmul_i2.c: Regenerated.
        * generated/matmul_i4.c: Regenerated.
        * generated/matmul_i8.c: Regenerated.
        * generated/matmul_r10.c: Regenerated.
        * generated/matmul_r16.c: Regenerated.
        * generated/matmul_r4.c: Regenerated.
        * generated/matmul_r8.c: Regenerated.
        * generated/matmulavx128_c10.c: Regenerated.
        * generated/matmulavx128_c16.c: Regenerated.
        * generated/matmulavx128_c4.c: Regenerated.
        * generated/matmulavx128_c8.c: Regenerated.
        * generated/matmulavx128_i1.c: Regenerated.
        * generated/matmulavx128_i16.c: Regenerated.
        * generated/matmulavx128_i2.c: Regenerated.
        * generated/matmulavx128_i4.c: Regenerated.
        * generated/matmulavx128_i8.c: Regenerated.
        * generated/matmulavx128_r10.c: Regenerated.
        * generated/matmulavx128_r16.c: Regenerated.
        * generated/matmulavx128_r4.c: Regenerated.
        * generated/matmulavx128_r8.c: Regenerated.

From-SVN: r264349
parent c546dbdc
Showing with 798 additions and 454 deletions
gcc/fortran/ChangeLog
2018-09-16 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/37802
* frontend-passes.c (B_ERROR): New macro for matmul bounds
checking error messages.
(C_ERROR): Likewise.
(inline_matmul_assign): Reorganize bounds checking, use B_ERROR
and C_ERROR macros.
2018-09-13 Bernd Edlinger <bernd.edlinger@hotmail.de> 2018-09-13 Bernd Edlinger <bernd.edlinger@hotmail.de>
* trans-array.c (gfc_conv_array_initializer): Remove excess precision * trans-array.c (gfc_conv_array_initializer): Remove excess precision
......
gcc/fortran/frontend-passes.c
...@@ -3748,6 +3748,15 @@ check_conjg_transpose_variable (gfc_expr *e, bool *conjg, bool *transpose) ...@@ -3748,6 +3748,15 @@ check_conjg_transpose_variable (gfc_expr *e, bool *conjg, bool *transpose)
return NULL; 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). /* Inline assignments of the form c = matmul(a,b).
Handle only the cases currently where b and c are rank-two arrays. 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_subtrees, ...@@ -3793,6 +3802,7 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
gfc_code *if_limit = NULL; gfc_code *if_limit = NULL;
gfc_code **next_code_point; gfc_code **next_code_point;
bool conjg_a, conjg_b, transpose_a, transpose_b; bool conjg_a, conjg_b, transpose_a, transpose_b;
bool realloc_c;
if (co->op != EXEC_ASSIGN) if (co->op != EXEC_ASSIGN)
return 0; return 0;
...@@ -3958,169 +3968,140 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees, ...@@ -3958,169 +3968,140 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
assign_zero->expr1->no_bounds_check = 1; assign_zero->expr1->no_bounds_check = 1;
assign_zero->expr2 = zero_e; assign_zero->expr2 = zero_e;
/* Handle the reallocation, if needed. */ realloc_c = flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1);
if (flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1))
{
gfc_code *lhs_alloc;
/* Only need to check a single dimension for the A2B2 case for if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
bounds checking, the rest will be allocated. Also check this {
for A2B1. */ gfc_code *test;
gfc_expr *a2, *b1, *c1, *c2, *a1, *b2;
if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) switch (m_case)
{ {
gfc_code *test; case A2B1:
if (m_case == A2B2 || m_case == A2B1)
{
gfc_expr *a2, *b1;
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
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, "Dimension of array B incorrect " test = runtime_error_ne (b1, a2, B_ERROR(1));
"in MATMUL intrinsic: Is %ld, should be %ld"); *next_code_point = test;
*next_code_point = test; next_code_point = &test->next;
next_code_point = &test->next;
}
else if (m_case == A1B2)
{
gfc_expr *a1, *b1;
if (!realloc_c)
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 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 (c1, a1, C_ERROR(1));
test = runtime_error_ne (b1, a1, "Dimension of array B incorrect "
"in MATMUL intrinsic: Is %ld, should be %ld");
*next_code_point = test; *next_code_point = test;
next_code_point = &test->next; next_code_point = &test->next;
} }
} break;
lhs_alloc = matmul_lhs_realloc (expr1, matrix_a, matrix_b, m_case);
*next_code_point = lhs_alloc;
next_code_point = &lhs_alloc->next;
} case A1B2:
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); b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
test = runtime_error_ne (b1, a2, "Dimension of array B incorrect " a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
"in MATMUL intrinsic: Is %ld, should be %ld"); test = runtime_error_ne (b1, a1, B_ERROR(1));
*next_code_point = test; *next_code_point = test;
next_code_point = &test->next; next_code_point = &test->next;
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); if (!realloc_c)
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); {
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
if (m_case == A2B2) b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " test = runtime_error_ne (c1, b2, C_ERROR(1));
"MATMUL intrinsic for dimension 1: " *next_code_point = test;
"is %ld, should be %ld"); next_code_point = &test->next;
else if (m_case == A2B1) }
test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " break;
"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); b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
test = runtime_error_ne (b1, a1, "Dimension of array B incorrect " a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
"in MATMUL intrinsic: Is %ld, should be %ld"); test = runtime_error_ne (b1, a2, B_ERROR(1));
*next_code_point = test; *next_code_point = test;
next_code_point = &test->next; next_code_point = &test->next;
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); if (!realloc_c)
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); {
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 " c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
"MATMUL intrinsic: " b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
"is %ld, should be %ld"); test = runtime_error_ne (c2, b2, C_ERROR(2));
*next_code_point = test;
next_code_point = &test->next;
}
break;
*next_code_point = test; case A2B2T:
next_code_point = &test->next;
}
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); b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
test = runtime_error_ne (c2, b2, "Incorrect extent in return array in " a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
"MATMUL intrinsic for dimension 2: is %ld, should be %ld"); /* matrix_b is transposed, hence dimension 1 for the error message. */
test = runtime_error_ne (b2, a2, B_ERROR(1));
*next_code_point = test; *next_code_point = test;
next_code_point = &test->next; next_code_point = &test->next;
}
if (m_case == A2B2T) if (!realloc_c)
{ {
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " test = runtime_error_ne (c1, a1, C_ERROR(1));
"MATMUL intrinsic for dimension 1: " *next_code_point = test;
"is %ld, should be %ld"); next_code_point = &test->next;
*next_code_point = test; c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
next_code_point = &test->next; 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;
case A2TB2:
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
test = runtime_error_ne (c2, b1, "Incorrect extent in return array in " a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
"MATMUL intrinsic for dimension 2: " test = runtime_error_ne (b1, a1, B_ERROR(1));
"is %ld, should be %ld");
*next_code_point = test; *next_code_point = test;
next_code_point = &test->next; next_code_point = &test->next;
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); if (!realloc_c)
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); {
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 " c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
"MATMUL intrnisic for dimension 2: " b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
"is %ld, should be %ld"); test = runtime_error_ne (c2, b2, C_ERROR(2));
*next_code_point = test; *next_code_point = test;
next_code_point = &test->next; next_code_point = &test->next;
}
break;
default:
gcc_unreachable ();
} }
}
if (m_case == A2TB2) /* Handle the reallocation, if needed. */
{
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, "Incorrect extent in return array in "
"MATMUL intrinsic for dimension 1: "
"is %ld, should be %ld");
*next_code_point = test;
next_code_point = &test->next;
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); if (realloc_c)
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); {
test = runtime_error_ne (c2, b2, "Incorrect extent in return array in " gfc_code *lhs_alloc;
"MATMUL intrinsic for dimension 2: "
"is %ld, should be %ld");
*next_code_point = test;
next_code_point = &test->next;
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); lhs_alloc = matmul_lhs_realloc (expr1, matrix_a, matrix_b, m_case);
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
test = runtime_error_ne (b1, a1, "Incorrect extent in argument B in " *next_code_point = lhs_alloc;
"MATMUL intrnisic for dimension 2: " next_code_point = &lhs_alloc->next;
"is %ld, should be %ld");
*next_code_point = test;
next_code_point = &test->next;
}
} }
*next_code_point = assign_zero; *next_code_point = assign_zero;
......
gcc/testsuite/ChangeLog
2018-09-16 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/37802
* gfortran.dg/matmul_bounds_13.f90: New test case.
* gfortran.dg/inline_matmul_15.f90: Adjust test for runtime
error.
* gfortran.dg/matmul_5.f90: Likewise.
* gfortran.dg/matmul_bounds_10.f90: Likewise.
* gfortran.dg/matmul_bounds_11.f90: Likewise.
* gfortran.dg/matmul_bounds_2.f90: Likewise.
* gfortran.dg/matmul_bounds_4.f90: Likewise.
* gfortran.dg/matmul_bounds_5.f90: Likewise.
2018-09-15 Eric Botcazou <ebotcazou@adacore.com> 2018-09-15 Eric Botcazou <ebotcazou@adacore.com>
* gcc.c-torture/compile/20180915-1.c: New test. * gcc.c-torture/compile/20180915-1.c: New test.
......
gcc/testsuite/gfortran.dg/inline_matmul_15.f90
...@@ -9,4 +9,4 @@ program main ...@@ -9,4 +9,4 @@ program main
call random_number(b) call random_number(b)
print *,matmul(a,b) print *,matmul(a,b)
end program main 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" }
gcc/testsuite/gfortran.dg/matmul_5.f90
...@@ -9,4 +9,4 @@ program main ...@@ -9,4 +9,4 @@ program main
call random_number(b) call random_number(b)
print *,matmul(a,b) print *,matmul(a,b)
end program main 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" }
gcc/testsuite/gfortran.dg/matmul_bounds_10.f90
...@@ -13,4 +13,4 @@ program main ...@@ -13,4 +13,4 @@ program main
allocate(ret(4,3)) allocate(ret(4,3))
ret = matmul(a,transpose(b)) ! This should throw an error. ret = matmul(a,transpose(b)) ! This should throw an error.
end program main 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.*" }
gcc/testsuite/gfortran.dg/matmul_bounds_11.f90
...@@ -11,5 +11,5 @@ program main ...@@ -11,5 +11,5 @@ program main
res = matmul(a,b) res = matmul(a,b)
print *,res print *,res
end program main 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" }
gcc/testsuite/gfortran.dg/matmul_bounds_13.f90 0 → 100644
! { dg-do run }
! { dg-options "-fcheck=bounds" }
! { dg-shouldfail "Fortran runtime error: Incorrect extent in argument B in MATMUL intrinsic in dimension 1" }
program main
real, dimension(:,:), allocatable :: a, b, c
character(len=100) :: line
allocate (a(3,2))
allocate (b(2,4))
call random_number(a)
call random_number(b)
write (unit=line, fmt=*) matmul(a,transpose(b))
end program main
! { dg-output "Fortran runtime error: Incorrect extent in argument B in MATMUL intrinsic in dimension 1" }
gcc/testsuite/gfortran.dg/matmul_bounds_2.f90
...@@ -13,4 +13,4 @@ program main ...@@ -13,4 +13,4 @@ program main
allocate(ret(3,2)) allocate(ret(3,2))
ret = matmul(a,b) ! This should throw an error. ret = matmul(a,b) ! This should throw an error.
end program main 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.*" }
gcc/testsuite/gfortran.dg/matmul_bounds_3.f90
...@@ -13,4 +13,4 @@ program main ...@@ -13,4 +13,4 @@ program main
allocate(ret(2,3)) allocate(ret(2,3))
ret = matmul(a,b) ! This should throw an error. ret = matmul(a,b) ! This should throw an error.
end program main 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" }
gcc/testsuite/gfortran.dg/matmul_bounds_4.f90
...@@ -13,4 +13,4 @@ program main ...@@ -13,4 +13,4 @@ program main
allocate(ret(3)) allocate(ret(3))
ret = matmul(a,b) ! This should throw an error. ret = matmul(a,b) ! This should throw an error.
end program main 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" }
gcc/testsuite/gfortran.dg/matmul_bounds_5.f90
...@@ -13,4 +13,4 @@ program main ...@@ -13,4 +13,4 @@ program main
allocate(ret(3)) allocate(ret(3))
ret = matmul(a,b) ! This should throw an error. ret = matmul(a,b) ! This should throw an error.
end program main 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" }
gcc/testsuite/gfortran.dg/matmul_bounds_8.f90
...@@ -13,4 +13,4 @@ program main ...@@ -13,4 +13,4 @@ program main
allocate(ret(3,2)) allocate(ret(3,2))
ret = matmul(a,transpose(b)) ! This should throw an error. ret = matmul(a,transpose(b)) ! This should throw an error.
end program main 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" }
libgfortran/ChangeLog
2018-09-16 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/37802
* m4/matmul_internal.m4: Adjust error messages.
* generated/matmul_c10.c: Regenerated.
* generated/matmul_c16.c: Regenerated.
* generated/matmul_c4.c: Regenerated.
* generated/matmul_c8.c: Regenerated.
* generated/matmul_i1.c: Regenerated.
* generated/matmul_i16.c: Regenerated.
* generated/matmul_i2.c: Regenerated.
* generated/matmul_i4.c: Regenerated.
* generated/matmul_i8.c: Regenerated.
* generated/matmul_r10.c: Regenerated.
* generated/matmul_r16.c: Regenerated.
* generated/matmul_r4.c: Regenerated.
* generated/matmul_r8.c: Regenerated.
* generated/matmulavx128_c10.c: Regenerated.
* generated/matmulavx128_c16.c: Regenerated.
* generated/matmulavx128_c4.c: Regenerated.
* generated/matmulavx128_c8.c: Regenerated.
* generated/matmulavx128_i1.c: Regenerated.
* generated/matmulavx128_i16.c: Regenerated.
* generated/matmulavx128_i2.c: Regenerated.
* generated/matmulavx128_i4.c: Regenerated.
* generated/matmulavx128_i8.c: Regenerated.
* generated/matmulavx128_r10.c: Regenerated.
* generated/matmulavx128_r16.c: Regenerated.
* generated/matmulavx128_r4.c: Regenerated.
* generated/matmulavx128_r8.c: Regenerated.
2018-09-14 Kyrylo Tkachov <kyrylo.tkachov@arm.com> 2018-09-14 Kyrylo Tkachov <kyrylo.tkachov@arm.com>
* io/unix.c (fallback_access): Avoid calling close on * io/unix.c (fallback_access): Avoid calling close on
......
libgfortran/generated/matmulavx128_c10.c
...@@ -109,8 +109,8 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_c16.c
...@@ -109,8 +109,8 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_c4.c
...@@ -109,8 +109,8 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_c8.c
...@@ -109,8 +109,8 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_i1.c
...@@ -109,8 +109,8 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_i16.c
...@@ -109,8 +109,8 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_i2.c
...@@ -109,8 +109,8 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_i4.c
...@@ -109,8 +109,8 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_i8.c
...@@ -109,8 +109,8 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_r10.c
...@@ -109,8 +109,8 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_r16.c
...@@ -109,8 +109,8 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_r4.c
...@@ -109,8 +109,8 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/generated/matmulavx128_r8.c
...@@ -109,8 +109,8 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray, ...@@ -109,8 +109,8 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -118,8 +118,8 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray, ...@@ -118,8 +118,8 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -127,17 +127,15 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray, ...@@ -127,17 +127,15 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -178,7 +176,9 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray, ...@@ -178,7 +176,9 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -223,7 +223,18 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray, ...@@ -223,7 +223,18 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
...@@ -667,8 +678,8 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray, ...@@ -667,8 +678,8 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -676,8 +687,8 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray, ...@@ -676,8 +687,8 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -685,17 +696,15 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray, ...@@ -685,17 +696,15 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray,
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -736,7 +745,9 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray, ...@@ -736,7 +745,9 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray,
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -781,7 +792,18 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray, ...@@ -781,7 +792,18 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restrict retarray,
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
libgfortran/m4/matmul_internal.m4
...@@ -59,8 +59,8 @@ ...@@ -59,8 +59,8 @@
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else if (GFC_DESCRIPTOR_RANK (b) == 1) else if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -68,8 +68,8 @@ ...@@ -68,8 +68,8 @@
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic: is %ld, should be %ld", "array (%ld/%ld) ",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
else else
...@@ -77,17 +77,15 @@ ...@@ -77,17 +77,15 @@
arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 1 of "
" MATMUL intrinsic for dimension 1:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent) if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in" runtime_error ("Array bound mismatch for dimension 2 of "
" MATMUL intrinsic for dimension 2:" "array (%ld/%ld) ",
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent); (long int) ret_extent, (long int) arg_extent);
} }
} }
...@@ -129,7 +127,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -129,7 +127,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
if (count != GFC_DESCRIPTOR_EXTENT(b,0)) if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{ {
if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 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) if (GFC_DESCRIPTOR_RANK (b) == 1)
...@@ -174,7 +174,18 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -174,7 +174,18 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1)
{ {
assert (gemm != NULL); 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, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest,
&ldc, 1, 1); &ldc, 1, 1);
return; return;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment