From patchwork Sun Sep 16 15:54:24 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 970326 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485720-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=quarantine dis=none) header.from=netcologne.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="wZMqSk+m"; dkim=pass (2048-bit key; unprotected) header.d=netcologne.de header.i=@netcologne.de header.b="jB7ibGqN"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 42Cv3L37Lkz9sBJ for ; Mon, 17 Sep 2018 01:55:09 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=tOzFqJ9WtSy9NbA0Z8f334ISOvomc5qVbgpP/T2waFQtLb8Bpt Tvs6lD1VTX+uvnMJgnjBhmimdIbGLcF274nJ0WpWlSn7jTl0q4xt6ZL4boGl5dC2 wraNIWqHe2B10EZC8LluRESU1Op5ccpiFS0HU1Y3dWYef+ks+ycwgiVhs= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=tJt7wJUQyCfyUlLiE9u5oubP1rU=; b=wZMqSk+m12jZgH5GSWwi ZFV/8HucYlND5fTAjQ3lmKDOItKVNmnaj0rbnBWzVxoeMOeVGABEH89fJPVkTk8f mQyRcclJlk3kVOyX670SibkuuaVFn/9vmKVJrSLFNuLHQFnpa95K9b9Y+tZPgGoR V8F0fXL73SkVQCYPsbio/Mc= Received: (qmail 42000 invoked by alias); 16 Sep 2018 15:54:46 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 41975 invoked by uid 89); 16 Sep 2018 15:54:44 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.7 required=5.0 tests=GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_LOW, SPF_PASS, TIME_LIMIT_EXCEEDED autolearn=unavailable version=3.3.2 spammy=lda, easier, Unify, unify X-HELO: cc-smtpout3.netcologne.de Received: from cc-smtpout3.netcologne.de (HELO cc-smtpout3.netcologne.de) (89.1.8.213) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 16 Sep 2018 15:54:33 +0000 Received: from cc-smtpin2.netcologne.de (cc-smtpin2.netcologne.de [89.1.8.202]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id 4E4F9125EA; Sun, 16 Sep 2018 17:54:30 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=netcologne.de; s=nc1116a; t=1537113270; bh=m0WVmI5IYYnOHvEcBsqn4s4dmMBaKpVNlWDYIRQJA/E=; h=To:From:Subject:Message-ID:Date:From; b=jB7ibGqNRZ0WqVnA7Blp7A0FBj6AiUaL3KISQ2k19JoPy1BiOmU2snoc16VP/g2OQ gDUMWcwUrDyQoV14UZg4NUXbrxfmbLw/yW0+g1j2aNhaiMxuRI2KG90bQt1W9YPIWv iR5vl+REHoG8yqThY6elaU9mGI84DtVEIemWGr1n1JSOI3UtKqtpvMLwGtn/AexFZF pA06WMrDOeBtxstNjhRxOTtRqPXLy/Ar4ZzpSY8o2qOcqM8wWh9fYZErS95cE6jAez RG8dXtK1z4seEGe+K2yALoR/c4G9GgxA1qmacCUTCYkiZeNa7eUKgKc9ctgi8pY5oe 2/PZ+PtNGSRDw== Received: from localhost (localhost [127.0.0.1]) by cc-smtpin2.netcologne.de (Postfix) with ESMTP id 3EB3511D99; Sun, 16 Sep 2018 17:54:30 +0200 (CEST) Received: from [78.35.132.184] (helo=cc-smtpin2.netcologne.de) by localhost with ESMTP (eXpurgate 4.6.0) (envelope-from ) id 5b9e7cb6-01b0-7f0000012729-7f000001ad9a-1 for ; Sun, 16 Sep 2018 17:54:30 +0200 Received: from [192.168.178.68] (xdsl-78-35-132-184.netcologne.de [78.35.132.184]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin2.netcologne.de (Postfix) with ESMTPSA; Sun, 16 Sep 2018 17:54:24 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Unify / fix error messages for matmul Message-ID: <52d026ff-fcf7-335a-84bb-68f25ae728e8@netcologne.de> Date: Sun, 16 Sep 2018 17:54:24 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.9.1 MIME-Version: 1.0 Hello world, looking through the code for run-time checking of matmul, I found that a) the code was not very clear, and b) due to this, at least one case was not checked correctly. So, here is a rewrite of that section. I have also made sure that the error messages now agree between library and compiler-generated error messages. The macros for error messages also contain the _ magic, so I hope that translation will be easier. I may also have fixed other bugs in that section, I didn't check very thoroughly. There was one suggestion in PR 37802. For code like c = matmul(a,b) where the boundaries of c were not correct, this is actually an error in the assignment, so I have made the error message match what we emit for normal array access out of bounds (like a(1:3) = b(1:2)). Regression-tested. OK for trunk? Regards Thomas 2018-09-16 Thomas Koenig 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 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 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. Index: gcc/fortran/frontend-passes.c =================================================================== --- gcc/fortran/frontend-passes.c (Revision 263838) +++ gcc/fortran/frontend-passes.c (Arbeitskopie) @@ -3748,6 +3748,15 @@ check_conjg_transpose_variable (gfc_expr *e, bool return NULL; } +/* Macros for unified error messages. */ + +#define B_ERROR(n) _("Incorrect extent in argument B in MATMUL intrinsic in " \ + "dimension " #n ": is %ld, should be %ld") + +#define C_ERROR(n) _("Array bound mismatch for dimension " #n " of array " \ + "(%ld/%ld)") + + /* Inline assignments of the form c = matmul(a,b). Handle only the cases currently where b and c are rank-two arrays. @@ -3793,6 +3802,7 @@ inline_matmul_assign (gfc_code **c, int *walk_subt gfc_code *if_limit = NULL; gfc_code **next_code_point; bool conjg_a, conjg_b, transpose_a, transpose_b; + bool realloc_c; if (co->op != EXEC_ASSIGN) return 0; @@ -3958,169 +3968,139 @@ inline_matmul_assign (gfc_code **c, int *walk_subt assign_zero->expr1->no_bounds_check = 1; assign_zero->expr2 = zero_e; - /* Handle the reallocation, if needed. */ - if (flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1)) + realloc_c = flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1); + + if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) { - gfc_code *lhs_alloc; + gfc_code *test; + gfc_expr *a2, *b1, *c1, *c2, *a1, *b2; - /* Only need to check a single dimension for the A2B2 case for - bounds checking, the rest will be allocated. Also check this - for A2B1. */ - - if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) + switch (m_case) { - gfc_code *test; - if (m_case == A2B2 || m_case == A2B1) - { - gfc_expr *a2, *b1; + case A2B1: - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); - b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a2, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; - } - else if (m_case == A1B2) + b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); + a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + test = runtime_error_ne (b1, a2, B_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; + + if (!realloc_c) { - gfc_expr *a1, *b1; - + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); - b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a1, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); + test = runtime_error_ne (c1, a1, C_ERROR(1)); *next_code_point = test; next_code_point = &test->next; } - } + break; - lhs_alloc = matmul_lhs_realloc (expr1, matrix_a, matrix_b, m_case); + case A1B2: - *next_code_point = lhs_alloc; - next_code_point = &lhs_alloc->next; - - } - else if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) - { - gfc_code *test; - gfc_expr *a2, *b1, *c1, *c2, *a1, *b2; - - if (m_case == A2B2 || m_case == A2B1) - { - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a2, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); + a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + test = runtime_error_ne (b1, a1, B_ERROR(1)); *next_code_point = test; next_code_point = &test->next; - c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); - a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + if (!realloc_c) + { + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); + b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + test = runtime_error_ne (c1, b2, C_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; + } + break; - if (m_case == A2B2) - test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 1: " - "is %ld, should be %ld"); - else if (m_case == A2B1) - test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " - "MATMUL intrinsic: " - "is %ld, should be %ld"); + case A2B2: - - *next_code_point = test; - next_code_point = &test->next; - } - else if (m_case == A1B2) - { - a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a1, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); + a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + test = runtime_error_ne (b1, a2, B_ERROR(1)); *next_code_point = test; next_code_point = &test->next; - c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); - b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + if (!realloc_c) + { + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); + a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + test = runtime_error_ne (c1, a1, C_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; - test = runtime_error_ne (c1, b2, "Incorrect extent in return array in " - "MATMUL intrinsic: " - "is %ld, should be %ld"); + c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); + b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + test = runtime_error_ne (c2, b2, C_ERROR(2)); + *next_code_point = test; + next_code_point = &test->next; + } + break; - *next_code_point = test; - next_code_point = &test->next; - } + case A2B2T: - if (m_case == A2B2) - { - c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); - test = runtime_error_ne (c2, b2, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 2: is %ld, should be %ld"); - + a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + test = runtime_error_ne (b2, a2, B_ERROR(2)); *next_code_point = test; next_code_point = &test->next; - } - if (m_case == A2B2T) - { - c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); - a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); - test = runtime_error_ne (c1, a1, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 1: " - "is %ld, should be %ld"); + if (!realloc_c) + { + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); + a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + test = runtime_error_ne (c1, a1, C_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; - *next_code_point = test; - next_code_point = &test->next; + c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); + b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); + test = runtime_error_ne (c2, b1, C_ERROR(2)); + *next_code_point = test; + next_code_point = &test->next; + } + break; - c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); + case A2TB2: + b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (c2, b1, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 2: " - "is %ld, should be %ld"); + a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + test = runtime_error_ne (b1, a1, B_ERROR(1)); *next_code_point = test; next_code_point = &test->next; - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); - b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + if (!realloc_c) + { + c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); + a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + test = runtime_error_ne (c1, a2, C_ERROR(1)); + *next_code_point = test; + next_code_point = &test->next; - test = runtime_error_ne (b2, a2, "Incorrect extent in argument B in " - "MATMUL intrnisic for dimension 2: " - "is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; + c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); + b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); + test = runtime_error_ne (c2, b2, C_ERROR(2)); + *next_code_point = test; + next_code_point = &test->next; + } + break; + default: + gcc_unreachable (); } + } - if (m_case == A2TB2) - { - c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1); - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + /* Handle the reallocation, if needed. */ - test = runtime_error_ne (c1, a2, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 1: " - "is %ld, should be %ld"); + if (realloc_c) + { + gfc_code *lhs_alloc; - *next_code_point = test; - next_code_point = &test->next; + lhs_alloc = matmul_lhs_realloc (expr1, matrix_a, matrix_b, m_case); - c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2); - b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2); - test = runtime_error_ne (c2, b2, "Incorrect extent in return array in " - "MATMUL intrinsic for dimension 2: " - "is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; + *next_code_point = lhs_alloc; + next_code_point = &lhs_alloc->next; - a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); - b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - - test = runtime_error_ne (b1, a1, "Incorrect extent in argument B in " - "MATMUL intrnisic for dimension 2: " - "is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; - - } } *next_code_point = assign_zero; Index: gcc/testsuite/gfortran.dg/inline_matmul_15.f90 =================================================================== --- gcc/testsuite/gfortran.dg/inline_matmul_15.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/inline_matmul_15.f90 (Arbeitskopie) @@ -9,4 +9,4 @@ program main call random_number(b) print *,matmul(a,b) end program main -! { dg-output "Fortran runtime error: Dimension of array B incorrect in MATMUL intrinsic.*" } +! { dg-output "Fortran runtime error: Incorrect extent in argument B in MATMUL intrinsic in dimension 1" } Index: gcc/testsuite/gfortran.dg/matmul_5.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_5.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_5.f90 (Arbeitskopie) @@ -9,4 +9,4 @@ program main call random_number(b) print *,matmul(a,b) end program main -! { dg-output "Fortran runtime error: dimension of array B incorrect in MATMUL intrinsic.*" } +! { dg-output "Fortran runtime error: Incorrect extent in argument B in MATMUL intrinsic in dimension 1" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_10.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_10.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_10.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(4,3)) ret = matmul(a,transpose(b)) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 4, should be 3" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array.*" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_11.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_11.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_11.f90 (Arbeitskopie) @@ -11,5 +11,5 @@ program main res = matmul(a,b) print *,res end program main -! { dg-output "Fortran runtime error: Dimension of array B incorrect in MATMUL intrinsic.*" } +! { dg-output "Fortran runtime error: Incorrect extent in argument B in MATMUL intrinsic in dimension 1: is 3, should be 2" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(3,2)) ret = matmul(a,b) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 2 of array.*" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(2,3)) ret = matmul(a,b) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 2, should be 3" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(3)) ret = matmul(a,b) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(3)) ret = matmul(a,b) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array" } Index: gcc/testsuite/gfortran.dg/matmul_bounds_8.f90 =================================================================== --- gcc/testsuite/gfortran.dg/matmul_bounds_8.f90 (Revision 263752) +++ gcc/testsuite/gfortran.dg/matmul_bounds_8.f90 (Arbeitskopie) @@ -13,4 +13,4 @@ program main allocate(ret(3,2)) ret = matmul(a,transpose(b)) ! This should throw an error. end program main -! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" } +! { dg-output "Fortran runtime error: Array bound mismatch for dimension 2 of array" } Index: libgfortran/generated/matmul_c10.c =================================================================== --- libgfortran/generated/matmul_c10.c (Revision 263856) +++ libgfortran/generated/matmul_c10.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_c10_avx (gfc_array_c10 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_c10_avx2 (gfc_array_c10 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_c10_avx512f (gfc_array_c10 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_c10_vanilla (gfc_array_c10 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_c10 (gfc_array_c10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_c10 (gfc_array_c10 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_c10 (gfc_array_c10 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_c16.c =================================================================== --- libgfortran/generated/matmul_c16.c (Revision 263856) +++ libgfortran/generated/matmul_c16.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_c16_avx (gfc_array_c16 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_c16_avx2 (gfc_array_c16 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_c16_avx512f (gfc_array_c16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_c16_vanilla (gfc_array_c16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_c16 (gfc_array_c16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_c16 (gfc_array_c16 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_c16 (gfc_array_c16 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_c4.c =================================================================== --- libgfortran/generated/matmul_c4.c (Revision 263856) +++ libgfortran/generated/matmul_c4.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_c4_avx (gfc_array_c4 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_c4_avx2 (gfc_array_c4 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_c4_avx512f (gfc_array_c4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_c4_vanilla (gfc_array_c4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_c8.c =================================================================== --- libgfortran/generated/matmul_c8.c (Revision 263856) +++ libgfortran/generated/matmul_c8.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_c8_avx (gfc_array_c8 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_c8_avx2 (gfc_array_c8 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_c8_avx512f (gfc_array_c8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_c8_vanilla (gfc_array_c8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i1.c =================================================================== --- libgfortran/generated/matmul_i1.c (Revision 263856) +++ libgfortran/generated/matmul_i1.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i1_avx (gfc_array_i1 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i1_avx2 (gfc_array_i1 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i1_avx512f (gfc_array_i1 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i1_vanilla (gfc_array_i1 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i16.c =================================================================== --- libgfortran/generated/matmul_i16.c (Revision 263856) +++ libgfortran/generated/matmul_i16.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i16_avx (gfc_array_i16 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i16_avx2 (gfc_array_i16 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i16_avx512f (gfc_array_i16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i16_vanilla (gfc_array_i16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i16 (gfc_array_i16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i16 (gfc_array_i16 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i16 (gfc_array_i16 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i2.c =================================================================== --- libgfortran/generated/matmul_i2.c (Revision 263856) +++ libgfortran/generated/matmul_i2.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i2_avx (gfc_array_i2 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i2_avx2 (gfc_array_i2 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i2_avx512f (gfc_array_i2 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i2_vanilla (gfc_array_i2 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i4.c =================================================================== --- libgfortran/generated/matmul_i4.c (Revision 263856) +++ libgfortran/generated/matmul_i4.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i4_avx (gfc_array_i4 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i4_avx2 (gfc_array_i4 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i4_avx512f (gfc_array_i4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i4_vanilla (gfc_array_i4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_i8.c =================================================================== --- libgfortran/generated/matmul_i8.c (Revision 263856) +++ libgfortran/generated/matmul_i8.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_i8_avx (gfc_array_i8 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_i8_avx2 (gfc_array_i8 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_i8_avx512f (gfc_array_i8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_i8_vanilla (gfc_array_i8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_r10.c =================================================================== --- libgfortran/generated/matmul_r10.c (Revision 263856) +++ libgfortran/generated/matmul_r10.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_r10_avx (gfc_array_r10 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_r10_avx2 (gfc_array_r10 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_r10_avx512f (gfc_array_r10 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_r10_vanilla (gfc_array_r10 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_r10 (gfc_array_r10 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_r10 (gfc_array_r10 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_r10 (gfc_array_r10 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_r16.c =================================================================== --- libgfortran/generated/matmul_r16.c (Revision 263856) +++ libgfortran/generated/matmul_r16.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_r16_avx (gfc_array_r16 * const restrict ret if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_r16_avx2 (gfc_array_r16 * const restrict re if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_r16_avx512f (gfc_array_r16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_r16_vanilla (gfc_array_r16 * const restrict if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_r16 (gfc_array_r16 * const restrict retarra arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_r16 (gfc_array_r16 * const restrict retarra if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_r16 (gfc_array_r16 * const restrict retarra if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_r4.c =================================================================== --- libgfortran/generated/matmul_r4.c (Revision 263856) +++ libgfortran/generated/matmul_r4.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_r4_avx (gfc_array_r4 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_r4_avx2 (gfc_array_r4 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_r4_avx512f (gfc_array_r4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_r4_vanilla (gfc_array_r4 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmul_r8.c =================================================================== --- libgfortran/generated/matmul_r8.c (Revision 263856) +++ libgfortran/generated/matmul_r8.c (Arbeitskopie) @@ -144,8 +144,8 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -153,8 +153,8 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -162,17 +162,15 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -213,7 +211,9 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -258,7 +258,18 @@ matmul_r8_avx (gfc_array_r8 * const restrict retar if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -701,8 +712,8 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -710,8 +721,8 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -719,17 +730,15 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -770,7 +779,9 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -815,7 +826,18 @@ matmul_r8_avx2 (gfc_array_r8 * const restrict reta if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1258,8 +1280,8 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1267,8 +1289,8 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1276,17 +1298,15 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1327,7 +1347,9 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1372,7 +1394,18 @@ matmul_r8_avx512f (gfc_array_r8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -1829,8 +1862,8 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1838,8 +1871,8 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -1847,17 +1880,15 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -1898,7 +1929,9 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -1943,7 +1976,18 @@ matmul_r8_vanilla (gfc_array_r8 * const restrict r if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -2460,8 +2504,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2469,8 +2513,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -2478,17 +2522,15 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -2529,7 +2571,9 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -2574,7 +2618,18 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_c10.c =================================================================== --- libgfortran/generated/matmulavx128_c10.c (Revision 263856) +++ libgfortran/generated/matmulavx128_c10.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_c10_avx128_fma3 (gfc_array_c10 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_c10_avx128_fma4 (gfc_array_c10 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_c16.c =================================================================== --- libgfortran/generated/matmulavx128_c16.c (Revision 263856) +++ libgfortran/generated/matmulavx128_c16.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_c16_avx128_fma3 (gfc_array_c16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_c16_avx128_fma4 (gfc_array_c16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_c4.c =================================================================== --- libgfortran/generated/matmulavx128_c4.c (Revision 263856) +++ libgfortran/generated/matmulavx128_c4.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_c4_avx128_fma3 (gfc_array_c4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_c4_avx128_fma4 (gfc_array_c4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_c8.c =================================================================== --- libgfortran/generated/matmulavx128_c8.c (Revision 263856) +++ libgfortran/generated/matmulavx128_c8.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_c8_avx128_fma3 (gfc_array_c8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_c8_avx128_fma4 (gfc_array_c8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i1.c =================================================================== --- libgfortran/generated/matmulavx128_i1.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i1.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i1_avx128_fma3 (gfc_array_i1 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i1_avx128_fma4 (gfc_array_i1 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i16.c =================================================================== --- libgfortran/generated/matmulavx128_i16.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i16.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i16_avx128_fma3 (gfc_array_i16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i16_avx128_fma4 (gfc_array_i16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i2.c =================================================================== --- libgfortran/generated/matmulavx128_i2.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i2.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i2_avx128_fma3 (gfc_array_i2 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i2_avx128_fma4 (gfc_array_i2 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i4.c =================================================================== --- libgfortran/generated/matmulavx128_i4.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i4.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i4_avx128_fma3 (gfc_array_i4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i4_avx128_fma4 (gfc_array_i4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_i8.c =================================================================== --- libgfortran/generated/matmulavx128_i8.c (Revision 263856) +++ libgfortran/generated/matmulavx128_i8.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_i8_avx128_fma3 (gfc_array_i8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_i8_avx128_fma4 (gfc_array_i8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_r10.c =================================================================== --- libgfortran/generated/matmulavx128_r10.c (Revision 263856) +++ libgfortran/generated/matmulavx128_r10.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_r10_avx128_fma3 (gfc_array_r10 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_r10_avx128_fma4 (gfc_array_r10 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_r16.c =================================================================== --- libgfortran/generated/matmulavx128_r16.c (Revision 263856) +++ libgfortran/generated/matmulavx128_r16.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_r16_avx128_fma3 (gfc_array_r16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_r16_avx128_fma4 (gfc_array_r16 * const rest if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_r4.c =================================================================== --- libgfortran/generated/matmulavx128_r4.c (Revision 263856) +++ libgfortran/generated/matmulavx128_r4.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_r4_avx128_fma3 (gfc_array_r4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_r4_avx128_fma4 (gfc_array_r4 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/generated/matmulavx128_r8.c =================================================================== --- libgfortran/generated/matmulavx128_r8.c (Revision 263856) +++ libgfortran/generated/matmulavx128_r8.c (Arbeitskopie) @@ -109,8 +109,8 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -118,8 +118,8 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -127,17 +127,15 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -178,7 +176,9 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -223,7 +223,18 @@ matmul_r8_avx128_fma3 (gfc_array_r8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; @@ -667,8 +678,8 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -676,8 +687,8 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -685,17 +696,15 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -736,7 +745,9 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -781,7 +792,18 @@ matmul_r8_avx128_fma4 (gfc_array_r8 * const restri if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return; Index: libgfortran/m4/matmul_internal.m4 =================================================================== --- libgfortran/m4/matmul_internal.m4 (Revision 263856) +++ libgfortran/m4/matmul_internal.m4 (Arbeitskopie) @@ -59,8 +59,8 @@ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -68,8 +68,8 @@ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic: is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } else @@ -77,17 +77,15 @@ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 1:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 1 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) - runtime_error ("Incorrect extent in return array in" - " MATMUL intrinsic for dimension 2:" - " is %ld, should be %ld", + runtime_error ("Array bound mismatch for dimension 2 of " + "array (%ld/%ld) ", (long int) ret_extent, (long int) arg_extent); } } @@ -129,7 +127,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) - runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + runtime_error ("Incorrect extent in argument B in MATMUL intrinsic " + "in dimension 1: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_EXTENT(b,0), (long int) count); } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -174,7 +174,18 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { assert (gemm != NULL); - gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, + const char *transa, *transb; + if (try_blas & 2) + transa = "C"; + else + transa = axstride == 1 ? "N" : "T"; + + if (try_blas & 4) + transb = "C"; + else + transb = bxstride == 1 ? "N" : "T"; + + gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); return;