phynexis-deps/eigen
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

BLAS: Pass string length in xerbla_ calls for Fortran ABI compatibility

Browse Source 
libeigen/eigen!2895
This commit is contained in:
Antonio Sánchez
2026-08-20 16:47:03 -07:00
committed by Rasmus Munk Larsen
parent 9be565330f
commit d812864302
12 changed files with 51 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files
blas/blas.h
+3 -1
View File
@@ -4,6 +4,8 @@
#ifndef BLAS_H
#define BLAS_H
#include <stddef.h>
#if defined(_WIN32)
#if defined(EIGEN_BLAS_BUILD_DLL)
#define EIGEN_BLAS_API __declspec(dllexport)
@@ -33,7 +35,7 @@ typedef unsigned long BLASULONG;
#endif
EIGEN_BLAS_API int BLASFUNC(lsame)(const char *, const char *);
EIGEN_BLAS_API void BLASFUNC(xerbla)(const char *, int *info);
EIGEN_BLAS_API void BLASFUNC(xerbla)(const char*, int* info, size_t len);
EIGEN_BLAS_API float BLASFUNC(sdot)(int *, float *, int *, float *, int *);
EIGEN_BLAS_API float BLASFUNC(sdsdot)(int *, float *, float *, int *, float *, int *);
blas/common.h
+2
View File
@@ -22,6 +22,8 @@
#include "blas.h"
constexpr size_t kBlasNameLength = 6;
namespace Eigen {
namespace internal {
// Optionally wraps an expression in a conjugation, used by the product kernels
blas/level1_cplx_impl.h
+1 -1
View File
@@ -127,7 +127,7 @@ extern "C" RealScalar EIGEN_CAT(REAL_SCALAR_SUFFIX, EIGEN_BLAS_FUNC_NAME(nrm2))(
if (*incx == 1) return make_vector(x, *n).stableNorm();
return make_vector(x, *n, *incx).stableNorm();
return make_vector(x, *n, std::abs(*incx)).stableNorm();
}
EIGEN_BLAS_FUNC(EIGEN_CAT(REAL_SCALAR_SUFFIX, rot))
blas/level2_cplx_impl.h
+9 -9
View File
@@ -48,7 +48,7 @@ EIGEN_BLAS_FUNC(hemv)
info = 7;
else if (*incy == 0)
info = 10;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HEMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HEMV ", &info, kBlasNameLength);
if (*n == 0) return;
@@ -103,7 +103,7 @@ EIGEN_BLAS_FUNC(hbmv)
info = 8;
else if (*incy == 0)
info = 11;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HBMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HBMV ", &info, kBlasNameLength);
if (*n == 0 || (alpha == Scalar(0) && beta == Scalar(1))) return;
@@ -208,7 +208,7 @@ EIGEN_BLAS_FUNC(hpmv)
info = 6;
else if (*incy == 0)
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HPMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HPMV ", &info, kBlasNameLength);
if (*n == 0 || (alpha == Scalar(0) && beta == Scalar(1))) return;
@@ -288,7 +288,7 @@ EIGEN_BLAS_FUNC(hpr)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int
info = 2;
else if (*incx == 0)
info = 5;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HPR ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HPR ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
@@ -333,7 +333,7 @@ EIGEN_BLAS_FUNC(hpr2)
info = 5;
else if (*incy == 0)
info = 7;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HPR2 ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HPR2 ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
@@ -378,7 +378,7 @@ EIGEN_BLAS_FUNC(her)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int
info = 5;
else if (*lda < std::max(1, *n))
info = 7;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HER ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HER ", &info, kBlasNameLength);
if (alpha == RealScalar(0)) return;
@@ -428,7 +428,7 @@ EIGEN_BLAS_FUNC(her2)
info = 7;
else if (*lda < std::max(1, *n))
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HER2 ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HER2 ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
@@ -471,7 +471,7 @@ EIGEN_BLAS_FUNC(geru)
info = 7;
else if (*lda < std::max(1, *m))
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "GERU ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "GERU ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
@@ -510,7 +510,7 @@ EIGEN_BLAS_FUNC(gerc)
info = 7;
else if (*lda < std::max(1, *m))
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "GERC ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "GERC ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
blas/level2_impl.h
+8 -8
View File
@@ -56,7 +56,7 @@ EIGEN_BLAS_FUNC(gemv)
info = 8;
else if (*incc == 0)
info = 11;
if (info) return xerbla_(SCALAR_SUFFIX_UP "GEMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "GEMV ", &info, kBlasNameLength);
if (*m == 0 || *n == 0 || (alpha == Scalar(0) && beta == Scalar(1))) return;
@@ -141,7 +141,7 @@ EIGEN_BLAS_FUNC(trsv)
info = 6;
else if (*incb == 0)
info = 8;
if (info) return xerbla_(SCALAR_SUFFIX_UP "TRSV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "TRSV ", &info, kBlasNameLength);
Scalar *actual_b = get_compact_vector(b, *n, *incb);
@@ -213,7 +213,7 @@ EIGEN_BLAS_FUNC(trmv)
info = 6;
else if (*incb == 0)
info = 8;
if (info) return xerbla_(SCALAR_SUFFIX_UP "TRMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "TRMV ", &info, kBlasNameLength);
if (*n == 0) return;
@@ -264,7 +264,7 @@ EIGEN_BLAS_FUNC(gbmv)
info = 10;
else if (*incy == 0)
info = 13;
if (info) return xerbla_(SCALAR_SUFFIX_UP "GBMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "GBMV ", &info, kBlasNameLength);
if (*m == 0 || *n == 0 || (alpha == Scalar(0) && beta == Scalar(1))) return;
@@ -334,7 +334,7 @@ EIGEN_BLAS_FUNC(tbmv)
info = 7;
else if (*incx == 0)
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "TBMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "TBMV ", &info, kBlasNameLength);
if (*n == 0) return;
@@ -527,7 +527,7 @@ EIGEN_BLAS_FUNC(tbsv)
info = 7;
else if (*incx == 0)
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "TBSV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "TBSV ", &info, kBlasNameLength);
if (*n == 0 || (*k == 0 && DIAG(*diag) == UNIT)) return;
@@ -614,7 +614,7 @@ EIGEN_BLAS_FUNC(tpmv)(char *uplo, char *opa, char *diag, int *n, RealScalar *pap
info = 4;
else if (*incx == 0)
info = 7;
if (info) return xerbla_(SCALAR_SUFFIX_UP "TPMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "TPMV ", &info, kBlasNameLength);
if (*n == 0) return;
@@ -703,7 +703,7 @@ EIGEN_BLAS_FUNC(tpsv)(char *uplo, char *opa, char *diag, int *n, RealScalar *pap
info = 4;
else if (*incx == 0)
info = 7;
if (info) return xerbla_(SCALAR_SUFFIX_UP "TPSV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "TPSV ", &info, kBlasNameLength);
Scalar *actual_x = get_compact_vector(x, *n, *incx);
blas/level2_real_impl.h
+8 -8
View File
@@ -43,7 +43,7 @@ EIGEN_BLAS_FUNC(symv)
info = 7;
else if (*incy == 0)
info = 10;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYMV ", &info, kBlasNameLength);
if (*n == 0) return;
@@ -94,7 +94,7 @@ EIGEN_BLAS_FUNC(syr)
info = 5;
else if (*ldc < std::max(1, *n))
info = 7;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYR ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYR ", &info, kBlasNameLength);
if (*n == 0 || alpha == Scalar(0)) return;
@@ -137,7 +137,7 @@ EIGEN_BLAS_FUNC(syr2)
info = 7;
else if (*ldc < std::max(1, *n))
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYR2 ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYR2 ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
@@ -191,7 +191,7 @@ EIGEN_BLAS_FUNC(sbmv)
info = 8;
else if (*incy == 0)
info = 11;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SBMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SBMV ", &info, kBlasNameLength);
if (*n == 0 || (alpha == Scalar(0) && beta == Scalar(1))) return;
@@ -299,7 +299,7 @@ EIGEN_BLAS_FUNC(spmv)
info = 6;
else if (*incy == 0)
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SPMV ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SPMV ", &info, kBlasNameLength);
if (*n == 0 || (alpha == Scalar(0) && beta == Scalar(1))) return;
@@ -377,7 +377,7 @@ EIGEN_BLAS_FUNC(spr)(char *uplo, int *n, Scalar *palpha, Scalar *px, int *incx,
info = 2;
else if (*incx == 0)
info = 5;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SPR ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SPR ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
@@ -422,7 +422,7 @@ EIGEN_BLAS_FUNC(spr2)
info = 5;
else if (*incy == 0)
info = 7;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SPR2 ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SPR2 ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
@@ -463,7 +463,7 @@ EIGEN_BLAS_FUNC(ger)
info = 7;
else if (*lda < std::max(1, *m))
info = 9;
if (info) return xerbla_(SCALAR_SUFFIX_UP "GER ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "GER ", &info, kBlasNameLength);
if (alpha == Scalar(0)) return;
blas/level3_impl.h
+10 -10
View File
@@ -75,7 +75,7 @@ EIGEN_BLAS_FUNC(gemm)
info = 10;
else if (*ldc < std::max(1, *m))
info = 13;
if (info) return xerbla_(SCALAR_SUFFIX_UP "GEMM ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "GEMM ", &info, kBlasNameLength);
if (*m == 0 || *n == 0) return;
@@ -196,7 +196,7 @@ EIGEN_BLAS_FUNC(gemmtr)
info = 10;
else if (*ldc < std::max(1, *n))
info = 13;
if (info) return xerbla_(SCALAR_SUFFIX_UP "GEMMTR ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "GEMMTR", &info, kBlasNameLength + 1);
if (*n == 0) return;
@@ -344,7 +344,7 @@ EIGEN_BLAS_FUNC(trsm)
info = 9;
else if (*ldb < std::max(1, *m))
info = 11;
if (info) return xerbla_(SCALAR_SUFFIX_UP "TRSM ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "TRSM ", &info, kBlasNameLength);
if (*m == 0 || *n == 0) return;
@@ -481,7 +481,7 @@ EIGEN_BLAS_FUNC(trmm)
info = 9;
else if (*ldb < std::max(1, *m))
info = 11;
if (info) return xerbla_(SCALAR_SUFFIX_UP "TRMM ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "TRMM ", &info, kBlasNameLength);
int code = OP(*opa) | (SIDE(*side) << 2) | (UPLO(*uplo) << 3) | (DIAG(*diag) << 4);
@@ -528,7 +528,7 @@ EIGEN_BLAS_FUNC(symm)
info = 9;
else if (*ldc < std::max(1, *m))
info = 12;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYMM ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYMM ", &info, kBlasNameLength);
if (beta != Scalar(1)) {
if (beta == Scalar(0))
@@ -646,7 +646,7 @@ EIGEN_BLAS_FUNC(syrk)
info = 7;
else if (*ldc < std::max(1, *n))
info = 10;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYRK ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYRK ", &info, kBlasNameLength);
if (beta != Scalar(1)) {
if (UPLO(*uplo) == UP)
@@ -714,7 +714,7 @@ EIGEN_BLAS_FUNC(syr2k)
info = 9;
else if (*ldc < std::max(1, *n))
info = 12;
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYR2K", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "SYR2K", &info, kBlasNameLength);
using Eigen::Lower;
using Eigen::Upper;
@@ -781,7 +781,7 @@ EIGEN_BLAS_FUNC(hemm)
info = 9;
else if (*ldc < std::max(1, *m))
info = 12;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HEMM ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HEMM ", &info, kBlasNameLength);
if (beta == Scalar(0))
matrix(c, *m, *n, *ldc).setZero();
@@ -881,7 +881,7 @@ EIGEN_BLAS_FUNC(herk)
info = 7;
else if (*ldc < std::max(1, *n))
info = 10;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HERK ", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HERK ", &info, kBlasNameLength);
int code = OP(*op) | (UPLO(*uplo) << 2);
@@ -936,7 +936,7 @@ EIGEN_BLAS_FUNC(her2k)
info = 9;
else if (*ldc < std::max(1, *n))
info = 12;
if (info) return xerbla_(SCALAR_SUFFIX_UP "HER2K", &info);
if (info) return xerbla_(SCALAR_SUFFIX_UP "HER2K", &info, kBlasNameLength);
using Eigen::Lower;
using Eigen::StrictlyLower;
blas/xerbla.cpp
+3 -1
View File
@@ -15,7 +15,9 @@
extern "C" {
#endif
EIGEN_WEAK_LINKING void xerbla_(const char *msg, int *info) { printf("Eigen BLAS ERROR #%i: %s\n", *info, msg); }
EIGEN_WEAK_LINKING void xerbla_(const char* msg, int* info, size_t len) {
printf("Eigen BLAS ERROR #%i: %.*s\n", *info, static_cast<int>(len), msg);
}
#ifdef __cplusplus
}
lapack/cholesky.inc
+2 -2
View File
@@ -22,7 +22,7 @@ EIGEN_LAPACK_FUNC(potrf)(const char *uplo, int *n, RealScalar *pa, int *lda, int
*info = -4;
if (*info != 0) {
int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "POTRF", &e);
return xerbla_(SCALAR_SUFFIX_UP "POTRF", &e, kBlasNameLength);
}
Scalar *a = reinterpret_cast<Scalar *>(pa);
@@ -54,7 +54,7 @@ EIGEN_LAPACK_FUNC(potrs)
*info = -7;
if (*info != 0) {
int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "POTRS", &e);
return xerbla_(SCALAR_SUFFIX_UP "POTRS", &e, kBlasNameLength);
}
Scalar *a = reinterpret_cast<Scalar *>(pa);
lapack/eigenvalues.inc
+1 -1
View File
@@ -32,7 +32,7 @@ EIGEN_LAPACK_FUNC(syev)
if (*info != 0) {
int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "SYEV ", &e);
return xerbla_(SCALAR_SUFFIX_UP "SYEV ", &e, kBlasNameLength);
}
if (query_size) {
lapack/lu.inc
+2 -2
View File
@@ -22,7 +22,7 @@ EIGEN_LAPACK_FUNC(getrf)(int *m, int *n, RealScalar *pa, int *lda, int *ipiv, in
*info = -4;
if (*info != 0) {
int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "GETRF", &e);
return xerbla_(SCALAR_SUFFIX_UP "GETRF", &e, kBlasNameLength);
}
if (*m == 0 || *n == 0) return;
@@ -55,7 +55,7 @@ EIGEN_LAPACK_FUNC(getrs)
*info = -8;
if (*info != 0) {
int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "GETRS", &e);
return xerbla_(SCALAR_SUFFIX_UP "GETRS", &e, kBlasNameLength);
}
Scalar *a = reinterpret_cast<Scalar *>(pa);
lapack/svd.inc
+2 -2
View File
@@ -45,7 +45,7 @@ EIGEN_LAPACK_FUNC(gesdd)
if (*info != 0) {
int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "GESDD ", &e);
return xerbla_(SCALAR_SUFFIX_UP "GESDD ", &e, kBlasNameLength);
}
if (query_size) {
@@ -115,7 +115,7 @@ EIGEN_LAPACK_FUNC(gesvd)
if (*info != 0) {
int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "GESVD ", &e);
return xerbla_(SCALAR_SUFFIX_UP "GESVD ", &e, kBlasNameLength);
}
if (query_size) {