From 40fa10396c0a3f9601cf49f6b6cd9922185c932e Mon Sep 17 00:00:00 2001
From: "Field G. Van Zee" <field@cs.utexas.edu>
Date: Mon, 19 Mar 2018 18:19:43 -0500
Subject: [PATCH] Fixed a few obscure bugs in the BLAS API.

Details:
- Fixed a missing parameter in the definition of sdsdot_(). The 'sb'
  argument was missing. Strangely, the argument is omitted from dsdot_()
  in the BLAS API.
- Fixed the missing 'c' or 'u' in the "?gerc" or "?geru" operation string
  passed to xerbla_() by the bla_ger_check() macro.
- For bla_syrk_check() and bla_syr2k_check() macros, only allow
  conjugate-transpose (trans='c') as a valid argument for the real
  domain functions [sd]syrk_() and [sd]syr2k_(). (Previously, the
  argument was allowed even for the complex domain equivalents, which
  was inconsistent with the BLAS API.)
---
 frame/compat/bla_dot.c               | 8 +++++---
 frame/compat/bla_dot.h               | 1 +
 frame/compat/bla_ger.c               | 1 +
 frame/compat/check/bla_ger_check.h   | 6 ++++--
 frame/compat/check/bla_syr2k_check.h | 6 +++++-
 frame/compat/check/bla_syrk_check.h  | 6 +++++-
 6 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/frame/compat/bla_dot.c b/frame/compat/bla_dot.c
index 4126bb564..63e422925 100644
--- a/frame/compat/bla_dot.c
+++ b/frame/compat/bla_dot.c
@@ -95,13 +95,15 @@ INSERT_GENTFUNCDOT_BLAS( dot, dotv )
 float PASTEF77(sd,sdot)
      (
        const f77_int* n,
+       const float*   sb,
        const float*   x, const f77_int* incx,
        const float*   y, const f77_int* incy
      )
 {
-	return ( float )PASTEF77(d,sdot)( n,
-	                                  x, incx,
-	                                  y, incy );
+	float r = ( float )PASTEF77(d,sdot)( n,
+	                                     x, incx,
+	                                     y, incy );
+	return r + *sb;
 }
 
 // Input vectors stored in single precision, computed in double precision,
diff --git a/frame/compat/bla_dot.h b/frame/compat/bla_dot.h
index bbdab19c3..411cf30ca 100644
--- a/frame/compat/bla_dot.h
+++ b/frame/compat/bla_dot.h
@@ -55,6 +55,7 @@ INSERT_GENTPROTDOT_BLAS( dot )
 float PASTEF77(sd,sdot)
      (
        const f77_int* n,
+       const float*   sb,
        const float*   x, const f77_int* incx,
        const float*   y, const f77_int* incy
      );
diff --git a/frame/compat/bla_ger.c b/frame/compat/bla_ger.c
index 85e17f1ff..f0724d8a6 100644
--- a/frame/compat/bla_ger.c
+++ b/frame/compat/bla_ger.c
@@ -66,6 +66,7 @@ void PASTEF772(ch,blasname,chc) \
 	( \
 	  MKSTR(ch), \
 	  MKSTR(blasname), \
+	  MKSTR(chc), \
 	  m, \
 	  n, \
 	  incx, \
diff --git a/frame/compat/check/bla_ger_check.h b/frame/compat/check/bla_ger_check.h
index c316517e5..a2e77b0c6 100644
--- a/frame/compat/check/bla_ger_check.h
+++ b/frame/compat/check/bla_ger_check.h
@@ -34,7 +34,7 @@
 
 #ifdef BLIS_ENABLE_BLAS2BLIS
 
-#define bla_ger_check( dt_str, op_str, m, n, incx, incy, lda ) \
+#define bla_ger_check( dt_str, op_str, conj_str, m, n, incx, incy, lda ) \
 { \
 	f77_int info = 0; \
 \
@@ -53,7 +53,9 @@
 	{ \
 		char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; \
 \
-		sprintf( func_str, "%s%-5s", dt_str, op_str ); \
+		/* We have to append an extra character to denote whether we
+		   are testing geru or gerc. */ \
+		sprintf( func_str, "%s%s%-2s", dt_str, op_str, conj_str ); \
 \
 		bli_string_mkupper( func_str ); \
 \
diff --git a/frame/compat/check/bla_syr2k_check.h b/frame/compat/check/bla_syr2k_check.h
index 82ab18518..70839e948 100644
--- a/frame/compat/check/bla_syr2k_check.h
+++ b/frame/compat/check/bla_syr2k_check.h
@@ -37,10 +37,14 @@
 #define bla_syr2k_check( dt_str, op_str, uploa, trans, m, k, lda, ldb, ldc ) \
 { \
 	f77_int info = 0; \
+	f77_int is_r; \
 	f77_int nota, ta, cta; \
 	f77_int lower, upper; \
 	f77_int nrowa; \
 \
+	static char* dt_cst = dt_str; \
+\
+	is_r  = ( dt_cst[0] == 's' || dt_cst[0] == 'd' ); \
 	nota  = PASTEF770(lsame)( trans, "N", (ftnlen)1, (ftnlen)1 ); \
 	ta    = PASTEF770(lsame)( trans, "T", (ftnlen)1, (ftnlen)1 ); \
 	cta   = PASTEF770(lsame)( trans, "C", (ftnlen)1, (ftnlen)1 ); \
@@ -52,7 +56,7 @@
 \
 	if      ( !lower && !upper ) \
 		info = 1; \
-	else if ( !nota && !ta && !cta ) \
+	else if ( !nota && !ta && (is_r ? !cta : 1) ) \
 		info = 2; \
 	else if ( *m < 0 ) \
 		info = 3; \
diff --git a/frame/compat/check/bla_syrk_check.h b/frame/compat/check/bla_syrk_check.h
index 386e143bd..b1faab420 100644
--- a/frame/compat/check/bla_syrk_check.h
+++ b/frame/compat/check/bla_syrk_check.h
@@ -37,10 +37,14 @@
 #define bla_syrk_check( dt_str, op_str, uploa, transa, m, k, lda, ldc ) \
 { \
 	f77_int info = 0; \
+	f77_int is_r; \
 	f77_int nota, ta, cta; \
 	f77_int lower, upper; \
 	f77_int nrowa; \
 \
+	static char* dt_cst = dt_str; \
+\
+	is_r  = ( dt_cst[0] == 's' || dt_cst[0] == 'd' ); \
 	nota  = PASTEF770(lsame)( transa, "N", (ftnlen)1, (ftnlen)1 ); \
 	ta    = PASTEF770(lsame)( transa, "T", (ftnlen)1, (ftnlen)1 ); \
 	cta   = PASTEF770(lsame)( transa, "C", (ftnlen)1, (ftnlen)1 ); \
@@ -52,7 +56,7 @@
 \
 	if      ( !lower && !upper ) \
 		info = 1; \
-	else if ( !nota && !ta && !cta ) \
+	else if ( !nota && !ta && (is_r ? !cta : 1) ) \
 		info = 2; \
 	else if ( *m < 0 ) \
 		info = 3; \