OpenBLAS/interface/gemmt.c

/*********************************************************************/
/* Copyright 2022, The OpenBLAS Project.                             */
/* All rights reserved.                                              */
/*                                                                   */
/* Redistribution and use in source and binary forms, with or        */
/* without modification, are permitted provided that the following   */
/* conditions are met:                                               */
/*                                                                   */
/*   1. Redistributions of source code must retain the above         */
/*      copyright notice, this list of conditions and the following  */
/*      disclaimer.                                                  */
/*                                                                   */
/*   2. Redistributions in binary form must reproduce the above      */
/*      copyright notice, this list of conditions and the following  */
/*      disclaimer in the documentation and/or other materials       */
/*      provided with the distribution.                              */
/*                                                                   */
/*    THIS  SOFTWARE IS PROVIDED  BY THE  UNIVERSITY OF  TEXAS AT    */
/*    AUSTIN  ``AS IS''  AND ANY  EXPRESS OR  IMPLIED WARRANTIES,    */
/*    INCLUDING, BUT  NOT LIMITED  TO, THE IMPLIED  WARRANTIES OF    */
/*    MERCHANTABILITY  AND FITNESS FOR  A PARTICULAR  PURPOSE ARE    */
/*    DISCLAIMED.  IN  NO EVENT SHALL THE UNIVERSITY  OF TEXAS AT    */
/*    AUSTIN OR CONTRIBUTORS BE  LIABLE FOR ANY DIRECT, INDIRECT,    */
/*    INCIDENTAL,  SPECIAL, EXEMPLARY,  OR  CONSEQUENTIAL DAMAGES    */
/*    (INCLUDING, BUT  NOT LIMITED TO,  PROCUREMENT OF SUBSTITUTE    */
/*    GOODS  OR  SERVICES; LOSS  OF  USE,  DATA,  OR PROFITS;  OR    */
/*    BUSINESS INTERRUPTION) HOWEVER CAUSED  AND ON ANY THEORY OF    */
/*    LIABILITY, WHETHER  IN CONTRACT, STRICT  LIABILITY, OR TORT    */
/*    (INCLUDING NEGLIGENCE OR OTHERWISE)  ARISING IN ANY WAY OUT    */
/*    OF  THE  USE OF  THIS  SOFTWARE,  EVEN  IF ADVISED  OF  THE    */
/*    POSSIBILITY OF SUCH DAMAGE.                                    */
/*                                                                   */
/*********************************************************************/

#include <stdio.h>
#include <stdlib.h>
#include "common.h"

#ifndef COMPLEX
#define SMP_THRESHOLD_MIN 65536.0
#ifdef RNAME
#ifdef XDOUBLE
#define ERROR_NAME "QGEMMTR"
#elif defined(DOUBLE)
#define ERROR_NAME "DGEMMTR"
#elif defined(BFLOAT16)
#define ERROR_NAME "SBGEMMTR"
#else
#define ERROR_NAME "SGEMMTR"
#endif
#else
#ifdef XDOUBLE
#define ERROR_NAME "QGEMMT "
#elif defined(DOUBLE)
#define ERROR_NAME "DGEMMT "
#elif defined(BFLOAT16)
#define ERROR_NAME "SBGEMMT "
#else
#define ERROR_NAME "SGEMMT "
#endif
#endif
#else
#define SMP_THRESHOLD_MIN 8192.0
#ifdef RNAME
#ifdef XDOUBLE
#define ERROR_NAME "XGEMMTR"
#elif defined(DOUBLE)
#define ERROR_NAME "ZGEMMTR"
#else
#define ERROR_NAME "CGEMMTR"
#endif
#else
#ifdef XDOUBLE
#define ERROR_NAME "XGEMMT "
#elif defined(DOUBLE)
#define ERROR_NAME "ZGEMMT "
#else
#define ERROR_NAME "CGEMMT "
#endif
#endif
#endif

#ifndef GEMM_MULTITHREAD_THRESHOLD
#define GEMM_MULTITHREAD_THRESHOLD 4
#endif

#ifndef CBLAS

void NAME(char *UPLO, char *TRANSA, char *TRANSB,
	  blasint * M, blasint * K,
	  FLOAT * Alpha,
	  IFLOAT * a, blasint * ldA,
	  IFLOAT * b, blasint * ldB, FLOAT * Beta, FLOAT * c, blasint * ldC)
{

	blasint m, k;
	blasint lda, ldb, ldc;
	int transa, transb, uplo;
	blasint info;

	char transA, transB, Uplo;
	blasint nrowa, nrowb;
#if defined(COMPLEX)
	blasint ncolb;
#endif
	IFLOAT *buffer;
	IFLOAT *aa, *bb;
	FLOAT *cc;
#if defined(COMPLEX)
	FLOAT alpha_r, alpha_i, beta_r, beta_i;
#else
	FLOAT alpha, beta;
#endif

	PRINT_DEBUG_NAME;

	m = *M;
	k = *K;

#if defined(COMPLEX)
	FLOAT *alpha = Alpha;
	alpha_r = *(Alpha + 0);
	alpha_i = *(Alpha + 1);

	beta_r = *(Beta + 0);
	beta_i = *(Beta + 1);
#else
	alpha = *Alpha;
	beta = *Beta;
#endif

	lda = *ldA;
	ldb = *ldB;
	ldc = *ldC;

	transA = *TRANSA;
	transB = *TRANSB;
	Uplo = *UPLO;
	TOUPPER(transA);
	TOUPPER(transB);
	TOUPPER(Uplo);

	transa = -1;
	transb = -1;
	uplo = -1;

	if (transA == 'N')
		transa = 0;
	if (transA == 'T')
		transa = 1;
#ifndef COMPLEX
	if (transA == 'R')
		transa = 0;
	if (transA == 'C')
		transa = 1;
#else
	if (transA == 'R')
		transa = 2;
	if (transA == 'C')
		transa = 3;
#endif

	if (transB == 'N')
		transb = 0;
	if (transB == 'T')
		transb = 1;
#ifndef COMPLEX
	if (transB == 'R')
		transb = 0;
	if (transB == 'C')
		transb = 1;
#else
	if (transB == 'R')
		transb = 2;
	if (transB == 'C')
		transb = 3;
#endif

	if (Uplo == 'U')
		uplo = 0;
	if (Uplo == 'L')
		uplo = 1;
	
	nrowa = m;
	if (transa & 1) nrowa = k;
	nrowb = k;
#if defined(COMPLEX)
	ncolb = m;
#endif
	if (transb & 1) {
		nrowb = m;
#if defined(COMPLEX)
		ncolb = k;
#endif
	}

	info = 0;

	if (ldc < MAX(1, m))
		info = 13;
	if (ldb < MAX(1, nrowb))
		info = 10;
	if (lda < MAX(1, nrowa))
		info = 8;
	if (k < 0)
		info = 5;
	if (m < 0)
		info = 4;
	if (transb < 0)
		info = 3;
	if (transa < 0)
		info = 2;
	if (uplo < 0)
		info = 1;

	if (info != 0) {
		BLASFUNC(xerbla) (ERROR_NAME, &info, sizeof(ERROR_NAME));
		return;
	}
#else

void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo,
	   enum CBLAS_TRANSPOSE TransA, enum CBLAS_TRANSPOSE TransB, blasint m,
	   blasint k,
#ifndef COMPLEX
	   FLOAT alpha,
	   IFLOAT * A, blasint LDA,
	   IFLOAT * B, blasint LDB, FLOAT beta, FLOAT * c, blasint ldc)
{
#else
	   void *valpha,
	   void *va, blasint LDA,
	   void *vb, blasint LDB, void *vbeta, void *vc, blasint ldc)
{
	FLOAT *alpha = (FLOAT *) valpha;
	FLOAT *beta = (FLOAT *) vbeta;
	FLOAT *A = (FLOAT *) va;
	FLOAT *B = (FLOAT *) vb;
	FLOAT *c = (FLOAT *) vc;
#endif
	FLOAT *aa, *bb, *cc;

	int transa, transb, uplo;
	blasint info;
	blasint lda, ldb;
	FLOAT *a, *b;
#if defined(COMPLEX)
	blasint nrowb, ncolb;
#endif
	XFLOAT *buffer;

	PRINT_DEBUG_CNAME;

	uplo = -1;
	transa = -1;
	transb = -1;
	info = 0;

	if (order == CblasColMajor) {
		if (Uplo == CblasUpper) uplo = 0;
		if (Uplo == CblasLower) uplo = 1;

		if (TransA == CblasNoTrans)
			transa = 0;
		if (TransA == CblasTrans)
			transa = 1;
#ifndef COMPLEX
		if (TransA == CblasConjNoTrans)
			transa = 0;
		if (TransA == CblasConjTrans)
			transa = 1;
#else
		if (TransA == CblasConjNoTrans)
			transa = 2;
		if (TransA == CblasConjTrans)
			transa = 3;
#endif
		if (TransB == CblasNoTrans)
			transb = 0;
		if (TransB == CblasTrans)
			transb = 1;
#ifndef COMPLEX
		if (TransB == CblasConjNoTrans)
			transb = 0;
		if (TransB == CblasConjTrans)
			transb = 1;
#else
		if (TransB == CblasConjNoTrans)
			transb = 2;
		if (TransB == CblasConjTrans)
			transb = 3;
#endif

		a = (void *)A;
		b = (void *)B;
		lda = LDA;
		ldb = LDB;

		info = -1;

		blasint nrowa;
#if !defined(COMPLEX)
		blasint nrowb;
#endif
		nrowa = m;
		if (transa & 1) nrowa = k;
		nrowb = k;
#if defined(COMPLEX)
		ncolb = m;
#endif
		if (transb & 1) {
			nrowb = m;
#if defined(COMPLEX)
			ncolb = k;
#endif
		}

		if (ldc < MAX(1, m))
			info = 13;
		if (ldb < MAX(1, nrowb))
			info = 10;
		if (lda < MAX(1, nrowa))
			info = 8;
		if (k < 0)
			info = 5;
		if (m < 0)
			info = 4;
		if (transb < 0)
			info = 3;
		if (transa < 0)
			info = 2;
		if (uplo < 0)
			info = 1;
	}

	if (order == CblasRowMajor) {

		a = (void *)B;
		b = (void *)A;

		lda = LDB;
		ldb = LDA;

		if (Uplo == CblasUpper) uplo = 1;
		if (Uplo == CblasLower) uplo = 0;

		if (TransB == CblasNoTrans)
			transa = 0;
		if (TransB == CblasTrans)
			transa = 1;
#ifndef COMPLEX
		if (TransB == CblasConjNoTrans)
			transa = 0;
		if (TransB == CblasConjTrans)
			transa = 1;
#else
		if (TransB == CblasConjNoTrans)
			transa = 2;
		if (TransB == CblasConjTrans)
			transa = 3;
#endif
		if (TransA == CblasNoTrans)
			transb = 0;
		if (TransA == CblasTrans)
			transb = 1;
#ifndef COMPLEX
		if (TransA == CblasConjNoTrans)
			transb = 0;
		if (TransA == CblasConjTrans)
			transb = 1;
#else
		if (TransA == CblasConjNoTrans)
			transb = 2;
		if (TransA == CblasConjTrans)
			transb = 3;
#endif

		info = -1;

		blasint ncola; 
#if !defined(COMPLEX)
		blasint ncolb;
#endif
		ncola = m;
		if (transa & 1) ncola = k;
		ncolb = k;
#if defined(COMPLEX)
		nrowb = m;
#endif

		if (transb & 1) {
#if defined(COMPLEX)
			nrowb = k;
#endif
			ncolb = m;
		}

		if (ldc < MAX(1,m))
			info = 13;
		if (ldb < MAX(1, ncolb))
			info = 8;
		if (lda < MAX(1, ncola))
			info = 10;
		if (k < 0)
			info = 5;
		if (m < 0)
			info = 4;
		if (transb < 0)
			info = 2;
		if (transa < 0)
			info = 3;
		if (uplo < 0)
			info = 1;
	}

	if (info >= 0) {
		BLASFUNC(xerbla) (ERROR_NAME, &info, sizeof(ERROR_NAME));
		return;
	}
#if defined(COMPLEX)
	FLOAT alpha_r = *(alpha + 0);
	FLOAT alpha_i = *(alpha + 1);

	FLOAT beta_r = *(beta + 0);
	FLOAT beta_i = *(beta + 1);
#endif

#endif
	int buffer_size;
	blasint l;
	blasint i, j;

#ifdef SMP
	int nthreads;
#endif

#if defined(COMPLEX)

#ifdef SMP
	static int (*gemv_thread[]) (BLASLONG, BLASLONG, FLOAT *, FLOAT *,
				     BLASLONG, FLOAT *, BLASLONG, FLOAT *,
				     BLASLONG, FLOAT *, int) = {
#ifdef XDOUBLE
		xgemv_thread_n, xgemv_thread_t, xgemv_thread_r, xgemv_thread_c,
		    xgemv_thread_o, xgemv_thread_u, xgemv_thread_s,
		    xgemv_thread_d,
#elif defined DOUBLE
		zgemv_thread_n, zgemv_thread_t, zgemv_thread_r, zgemv_thread_c,
		    zgemv_thread_o, zgemv_thread_u, zgemv_thread_s,
		    zgemv_thread_d,
#else
		cgemv_thread_n, cgemv_thread_t, cgemv_thread_r, cgemv_thread_c,
		    cgemv_thread_o, cgemv_thread_u, cgemv_thread_s,
		    cgemv_thread_d,
#endif
	};
#endif

	int (*gemv[]) (BLASLONG, BLASLONG, BLASLONG, FLOAT, FLOAT, FLOAT *,
		       BLASLONG, FLOAT *, BLASLONG, FLOAT *, BLASLONG,
		       FLOAT *) = {
	GEMV_N, GEMV_T, GEMV_R, GEMV_C, GEMV_O, GEMV_U, GEMV_S, GEMV_D,};

#else

#ifdef SMP
	static int (*gemv_thread[]) (BLASLONG, BLASLONG, FLOAT, FLOAT *,
				     BLASLONG, FLOAT *, BLASLONG, FLOAT *,
				     BLASLONG, FLOAT *, int) = {
#ifdef XDOUBLE
		qgemv_thread_n, qgemv_thread_t,
#elif defined DOUBLE
		dgemv_thread_n, dgemv_thread_t,
#else
		sgemv_thread_n, sgemv_thread_t,
#endif
	};
#endif
	int (*gemv[]) (BLASLONG, BLASLONG, BLASLONG, FLOAT, FLOAT *, BLASLONG,
		       FLOAT *, BLASLONG, FLOAT *, BLASLONG, FLOAT *) = {
	GEMV_N, GEMV_T,};

#endif

	if (m == 0)
		return;

	IDEBUG_START;

#if defined(COMPLEX)
	if (transb > 1){
#ifndef CBLAS
		IMATCOPY_K_CNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb);
#else
		if (order == CblasColMajor)
			IMATCOPY_K_CNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb);
		if (order == CblasRowMajor)
			IMATCOPY_K_RNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb);
#endif
	}
#endif

	const blasint incb = ((transb & 1) == 0) ? 1 : ldb;

	if (uplo == 1) {
		for (i = 0; i < m; i++) {
			j = m - i;

			l = j;
#if defined(COMPLEX)
			aa = a + i * 2;
			bb = b + i * ldb * 2;
			if (transa & 1) {
				aa = a + lda * i * 2;
			}
			if (transb & 1)
				bb = b + i * 2;
			cc = c + i * 2 * ldc + i * 2;
#else
			aa = a + i;
			bb = b + i * ldb;
			if (transa & 1) {
				aa = a + lda * i;
			}
			if (transb & 1)
				bb = b + i;
			cc = c + i * ldc + i;
#endif

#if defined(COMPLEX)
			if (beta_r != ONE || beta_i != ZERO)
				SCAL_K(l, 0, 0, beta_r, beta_i, cc, 1, NULL, 0,
				       NULL, 0);

			if (alpha_r == ZERO && alpha_i == ZERO)
				continue;
#else
			if (beta != ONE)
				SCAL_K(l, 0, 0, beta, cc, 1, NULL, 0, NULL, 0);

			if (alpha == ZERO)
				continue;
#endif

			IDEBUG_START;

			buffer_size = 2 * (j + k) + 128 / sizeof(FLOAT);
#ifdef WINDOWS_ABI
			buffer_size += 160 / sizeof(FLOAT);
#endif
			// for alignment
			buffer_size = (buffer_size + 3) & ~3;
			STACK_ALLOC(buffer_size, IFLOAT, buffer);

#ifdef SMP

			if (1L * j * k < 2304L * GEMM_MULTITHREAD_THRESHOLD)
				nthreads = 1;
			else
				nthreads = num_cpu_avail(2);

			if (nthreads == 1) {
#endif

#if defined(COMPLEX)
				if (!(transa & 1))
				(gemv[(int)transa]) (j, k, 0, alpha_r, alpha_i,
						     aa, lda, bb, incb, cc, 1,
						     buffer);
				else
				(gemv[(int)transa]) (k, j, 0, alpha_r, alpha_i,
						     aa, lda, bb, incb, cc, 1,
						     buffer);
#else
				if (!(transa & 1))
				(gemv[(int)transa]) (j, k, 0, alpha, aa, lda,
						     bb, incb, cc, 1, buffer);
				else
				(gemv[(int)transa]) (k, j, 0, alpha, aa, lda,
						     bb, incb, cc, 1, buffer);
#endif
#ifdef SMP
			} else {
				if (!(transa & 1))
				(gemv_thread[(int)transa]) (j, k, alpha, aa,
							    lda, bb, incb, cc,
							    1, buffer,
							    nthreads);
				else
				(gemv_thread[(int)transa]) (k, j, alpha, aa,
							    lda, bb, incb, cc,
							    1, buffer,
							    nthreads);

			}
#endif

			STACK_FREE(buffer);
		}
	} else {

		for (i = 0; i < m; i++) {
			j = i + 1;

			l = j;
#if defined COMPLEX
			bb = b + i * ldb * 2;
			if (transb & 1) {
				bb = b + i * 2;
			}
			cc = c + i * 2 * ldc;
#else
			bb = b + i * ldb;
			if (transb & 1) {
				bb = b + i;
			}
			cc = c + i * ldc;
#endif

#if defined(COMPLEX)
			if (beta_r != ONE || beta_i != ZERO)
				SCAL_K(l, 0, 0, beta_r, beta_i, cc, 1, NULL, 0,
				       NULL, 0);

			if (alpha_r == ZERO && alpha_i == ZERO)
				continue;
#else
			if (beta != ONE)
				SCAL_K(l, 0, 0, beta, cc, 1, NULL, 0, NULL, 0);

			if (alpha == ZERO)
				continue;
#endif
			IDEBUG_START;

			buffer_size = 2 * (j + k) + 128 / sizeof(FLOAT);
#ifdef WINDOWS_ABI
			buffer_size += 160 / sizeof(FLOAT);
#endif
			// for alignment
			buffer_size = (buffer_size + 3) & ~3;
			STACK_ALLOC(buffer_size, IFLOAT, buffer);

#ifdef SMP

			if (1L * j * k < 2304L * GEMM_MULTITHREAD_THRESHOLD)
				nthreads = 1;
			else
				nthreads = num_cpu_avail(2);

			if (nthreads == 1) {
#endif

#if defined(COMPLEX)
				if (!(transa & 1))
				(gemv[(int)transa]) (j, k, 0, alpha_r, alpha_i,
						     a, lda, bb, incb, cc, 1,
						     buffer);
				else
				(gemv[(int)transa]) (k, j, 0, alpha_r, alpha_i,
						     a, lda, bb, incb, cc, 1,
						     buffer);
#else
				if (!(transa & 1))
				(gemv[(int)transa]) (j, k, 0, alpha, a, lda, bb,
						     incb, cc, 1, buffer);
				else
				(gemv[(int)transa]) (k, j, 0, alpha, a, lda, bb,
						     incb, cc, 1, buffer);
#endif

#ifdef SMP
			} else {
				if (!(transa & 1))
				(gemv_thread[(int)transa]) (j, k, alpha, a, lda,
							    bb, incb, cc, 1,
							    buffer, nthreads);
				else
				(gemv_thread[(int)transa]) (k, j, alpha, a, lda,
							    bb, incb, cc, 1,
							    buffer, nthreads);
			}
#endif

			STACK_FREE(buffer);
		}
	}

	IDEBUG_END;

/* transform B back if necessary */
#if defined(COMPLEX)
	if (transb > 1){
#ifndef CBLAS
		IMATCOPY_K_CNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb);
#else
		if (order == CblasColMajor)
			IMATCOPY_K_CNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb);
		if (order == CblasRowMajor)
			IMATCOPY_K_RNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb);
#endif
	}
#endif

	return;
}