;; blas.scm

(module blas

	(RowMajor
	 ColMajor
	 NoTrans
	 Trans
	 ConjTrans
	 Left
	 Right
	 Upper
	 Lower
	 Unit
	 NonUnit

	 sicopy
	 dicopy
	 cicopy
	 zicopy

	 scopy
	 dcopy
	 ccopy
	 zcopy

	 unsafe-sgemm!
	 unsafe-dgemm!
	 unsafe-cgemm!
	 unsafe-zgemm!
	 sgemm!
	 dgemm!
	 cgemm!
	 zgemm!
	 sgemm
	 dgemm
	 cgemm
	 zgemm

	 unsafe-ssymm!
	 unsafe-dsymm!
	 unsafe-csymm!
	 unsafe-zsymm!
	 ssymm!
	 dsymm!
	 csymm!
	 zsymm!
	 ssymm
	 dsymm
	 csymm
	 zsymm

	 unsafe-chemm!
	 unsafe-zhemm!
	 chemm!
	 zhemm!
	 chemm
	 zhemm

	 unsafe-ssyrk!
	 unsafe-dsyrk!
	 unsafe-csyrk!
	 unsafe-zsyrk!
	 ssyrk!
	 dsyrk!
	 csyrk!
	 zsyrk!
	 ssyrk
	 dsyrk
	 csyrk
	 zsyrk

	 unsafe-cherk!
	 unsafe-zherk!
	 cherk!
	 zherk!
	 cherk
	 zherk

	 unsafe-ssyr2k!
	 unsafe-dsyr2k!
	 unsafe-csyr2k!
	 unsafe-zsyr2k!
	 ssyr2k!
	 dsyr2k!
	 csyr2k!
	 zsyr2k!
	 ssyr2k
	 dsyr2k
	 csyr2k
	 zsyr2k

	 unsafe-cher2k!
	 unsafe-zher2k!
	 cher2k!
	 zher2k!
	 cher2k
	 zher2k

	 unsafe-strmm!
	 unsafe-dtrmm!
	 unsafe-ctrmm!
	 unsafe-ztrmm!
	 strmm!
	 dtrmm!
	 ctrmm!
	 ztrmm!
	 strmm
	 dtrmm
	 ctrmm
	 ztrmm

	 unsafe-strsm!
	 unsafe-dtrsm!
	 unsafe-ctrsm!
	 unsafe-ztrsm!
	 strsm!
	 dtrsm!
	 ctrsm!
	 ztrsm!
	 strsm
	 dtrsm
	 ctrsm
	 ztrsm

	 unsafe-sgemv!
	 unsafe-dgemv!
	 unsafe-cgemv!
	 unsafe-zgemv!
	 sgemv!
	 dgemv!
	 cgemv!
	 zgemv!
	 sgemv
	 dgemv
	 cgemv
	 zgemv

	 unsafe-chemv!
	 unsafe-zhemv!
	 chemv!
	 zhemv!
	 chemv
	 zhemv
	 unsafe-chbmv!
	 unsafe-zhbmv!
	 chbmv!
	 zhbmv!
	 chbmv
	 zhbmv
	 unsafe-chpmv!
	 unsafe-zhpmv!
	 chpmv!
	 zhpmv!
	 chpmv
	 zhpmv
	 unsafe-ssymv!
	 unsafe-dsymv!
	 ssymv!
	 dsymv!
	 ssymv
	 dsymv
	 unsafe-ssbmv!
	 unsafe-dsbmv!
	 ssbmv!
	 dsbmv!
	 ssbmv
	 dsbmv
	 unsafe-sspmv!
	 unsafe-dspmv!
	 sspmv!
	 dspmv!
	 sspmv
	 dspmv
	 unsafe-strmv!
	 unsafe-dtrmv!
	 unsafe-ctrmv!
	 unsafe-ztrmv!
	 strmv!
	 dtrmv!
	 ctrmv!
	 ztrmv!
	 strmv
	 dtrmv
	 ctrmv
	 ztrmv
	 unsafe-stbmv!
	 unsafe-dtbmv!
	 unsafe-ctbmv!
	 unsafe-ztbmv!
	 stbmv!
	 dtbmv!
	 ctbmv!
	 ztbmv!
	 stbmv
	 dtbmv
	 ctbmv
	 ztbmv
	 unsafe-stpmv!
	 unsafe-dtpmv!
	 unsafe-ctpmv!
	 unsafe-ztpmv!
	 stpmv!
	 dtpmv!
	 ctpmv!
	 ztpmv!
	 stpmv
	 dtpmv
	 ctpmv
	 ztpmv
	 unsafe-strsv!
	 unsafe-dtrsv!
	 unsafe-ctrsv!
	 unsafe-ztrsv!
	 strsv!
	 dtrsv!
	 ctrsv!
	 ztrsv!
	 strsv
	 dtrsv
	 ctrsv
	 ztrsv
	 unsafe-stbsv!
	 unsafe-dtbsv!
	 unsafe-ctbsv!
	 unsafe-ztbsv!
	 stbsv!
	 dtbsv!
	 ctbsv!
	 ztbsv!
	 stbsv
	 dtbsv
	 ctbsv
	 ztbsv
	 unsafe-stpsv!
	 unsafe-dtpsv!
	 unsafe-ctpsv!
	 unsafe-ztpsv!
	 stpsv!
	 dtpsv!
	 ctpsv!
	 ztpsv!
	 stpsv
	 dtpsv
	 ctpsv
	 ztpsv
	 unsafe-sger!
	 unsafe-dger!
	 sger!
	 dger!
	 sger
	 dger
	 unsafe-siger!
	 unsafe-diger!
	 siger!
	 diger!
	 siger
	 diger
	 unsafe-cgeru!
	 unsafe-zgeru!
	 cgeru!
	 zgeru!
	 cgeru
	 zgeru
	 unsafe-cgerc!
	 unsafe-zgerc!
	 cgerc!
	 zgerc!
	 cgerc
	 zgerc
	 unsafe-cher!
	 unsafe-zher!
	 cher!
	 zher!
	 cher
	 zher
	 unsafe-chpr!
	 unsafe-zhpr!
	 chpr!
	 zhpr!
	 chpr
	 zhpr
	 unsafe-cher2!
	 unsafe-zher2!
	 cher2!
	 zher2!
	 cher2
	 zher2
	 unsafe-chpr2!
	 unsafe-zhpr2!
	 chpr2!
	 zhpr2!
	 chpr2
	 zhpr2
	 unsafe-ssyr!
	 unsafe-dsyr!
	 ssyr!
	 dsyr!
	 ssyr
	 dsyr
	 unsafe-sspr!
	 unsafe-dspr!
	 sspr!
	 dspr!
	 sspr
	 dspr
	 unsafe-ssyr2!
	 unsafe-dsyr2!
	 ssyr2!
	 dsyr2!
	 ssyr2
	 dsyr2
	 unsafe-sspr2!
	 unsafe-dspr2!
	 sspr2!
	 dspr2!
	 sspr2
	 dspr2

	 unsafe-srot!
	 unsafe-drot!
	 srot!
	 drot!
	 srot
	 drot
	 unsafe-srotm!
	 unsafe-drotm!
	 srotm!
	 drotm!
	 srotm
	 drotm
	 unsafe-sswap!
	 unsafe-dswap!
	 unsafe-cswap!
	 unsafe-zswap!
	 sswap!
	 dswap!
	 cswap!
	 zswap!
	 sswap
	 dswap
	 cswap
	 zswap
	 unsafe-sscal!
	 unsafe-dscal!
	 unsafe-cscal!
	 unsafe-zscal!
	 sscal!
	 dscal!
	 cscal!
	 zscal!
	 sscal
	 dscal
	 cscal
	 zscal
	 unsafe-saxpy!
	 unsafe-daxpy!
	 unsafe-caxpy!
	 unsafe-zaxpy!
	 saxpy!
	 daxpy!
	 caxpy!
	 zaxpy!
	 saxpy
	 daxpy
	 caxpy
	 zaxpy
	 unsafe-siaxpy!
	 unsafe-diaxpy!
	 unsafe-ciaxpy!
	 unsafe-ziaxpy!
	 siaxpy!
	 diaxpy!
	 ciaxpy!
	 ziaxpy!
	 siaxpy
	 diaxpy
	 ciaxpy
	 ziaxpy
	 sdot
	 ddot
	 cdotu
	 zdotu
	 cdotc
	 zdotc
	 snrm2
	 dnrm2
	 cnrm2
	 znrm2
	 sasum
	 dasum
	 casum
	 zasum
	 samax
	 damax
	 camax
	 zamax
	 )

  (import scheme chicken data-structures foreign)

  (require-extension srfi-4 bind)

(define (blas:error x . rest)
  (let ((port (open-output-string)))
    (let loop ((objs (if (symbol? x) rest (cons x rest))))
      (if (null? objs)
	  (begin
	    (newline port)
	    (error (if (symbol? x) x 'blas) 
		   (get-output-string port)))
	  (begin (display (car objs) port)
		 (display " " port)
		 (loop (cdr objs)))))))


(bind* #<<EOF

typedef float CCOMPLEX;
typedef double ZCOMPLEX; 
typedef int CBLAS_INDEX;


/*
 * Enumerated and derived types
 */

enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102};
enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113};
enum CBLAS_UPLO {CblasUpper=121, CblasLower=122};
enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132};
enum CBLAS_SIDE {CblasLeft=141, CblasRight=142};

/*
 * ===========================================================================
 * Prototypes for level 1 BLAS routines
 * ===========================================================================
 */

/* 
 * Routines with standard 4 prefixes (s, d, c, z)
 */
void cblas_sswap(const int N, float *X, const int incX, 
                 float *Y, const int incY);
void cblas_scopy(const int N, const float *X, const int incX, 
                 float *Y, const int incY);
void cblas_saxpy(const int N, const float alpha, const float *X,
                 const int incX, float *Y, const int incY);

void cblas_dswap(const int N, double *X, const int incX, 
                 double *Y, const int incY);
void cblas_dcopy(const int N, const double *X, const int incX, 
                 double *Y, const int incY);
void cblas_daxpy(const int N, const double alpha, const double *X,
                 const int incX, double *Y, const int incY);

void cblas_cswap(const int N, CCOMPLEX *X, const int incX, 
                 CCOMPLEX *Y, const int incY);
void cblas_ccopy(const int N, const CCOMPLEX *X, const int incX, 
                 CCOMPLEX *Y, const int incY);
void cblas_caxpy(const int N, const CCOMPLEX *alpha, const CCOMPLEX *X,
                 const int incX, CCOMPLEX *Y, const int incY);

void cblas_zswap(const int N, ZCOMPLEX *X, const int incX, 
                 ZCOMPLEX *Y, const int incY);
void cblas_zcopy(const int N, const ZCOMPLEX *X, const int incX, 
                 ZCOMPLEX *Y, const int incY);
void cblas_zaxpy(const int N, const ZCOMPLEX *alpha, const ZCOMPLEX *X,
                 const int incX, ZCOMPLEX *Y, const int incY);


/* 
 * Routines with S and D prefix only
 */
void cblas_srotg(float *a, float *b, float *c, float *s);
void cblas_srotmg(float *d1, float *d2, float *b1, const float b2, float *P);
void cblas_srot(const int N, float *X, const int incX,
                float *Y, const int incY, const float c, const float s);
void cblas_srotm(const int N, float *X, const int incX,
                float *Y, const int incY, const float *P);

void cblas_drotg(double *a, double *b, double *c, double *s);
void cblas_drotmg(double *d1, double *d2, double *b1, const double b2, double *P);
void cblas_drot(const int N, double *X, const int incX,
                double *Y, const int incY, const double c, const double  s);
void cblas_drotm(const int N, double *X, const int incX,
                double *Y, const int incY, const double *P);


/* 
 * Routines with S D C Z CS and ZD prefixes
 */
void cblas_sscal(const int N, const float alpha, float *X, const int incX);
void cblas_dscal(const int N, const double alpha, double *X, const int incX);
void cblas_cscal(const int N, const CCOMPLEX *alpha, CCOMPLEX *X, const int incX);
void cblas_zscal(const int N, const ZCOMPLEX *alpha, ZCOMPLEX *X, const int incX);
void cblas_csscal(const int N, const float alpha, CCOMPLEX *X, const int incX);
void cblas_zdscal(const int N, const double alpha, ZCOMPLEX *X, const int incX);


/* Offset variations of the copy, axpy routines */

void sicopy(const int N, const float *X, const int incX, const
		  int offsetX, float *Y, const int incY, const int offsetY)
{
  cblas_scopy (N, X+offsetX, incX, Y+offsetY, incY);
}

void dicopy(const int N, const double *X, const int incX, const
		  int offsetX, double *Y, const int incY, const int offsetY)
{
  cblas_dcopy (N, X+offsetX, incX, Y+offsetY, incY);
}


void cicopy(const int N, const CCOMPLEX *X, const int incX, const
		  int offsetX, CCOMPLEX *Y, const int incY, const int offsetY)
{
  cblas_ccopy (N, X+(2*offsetX), incX, Y+(2*offsetY), incY);
}

void zicopy(const int N, const ZCOMPLEX *X, const int incX, const
		  int offsetX, ZCOMPLEX *Y, const int incY, const int offsetY)
{
  cblas_zcopy (N, X+(2*offsetX), incX, Y+(2*offsetY), incY);
}


void cblas_siaxpy(const int N, const float alpha, 
			const float *X, const int incX, const int offsetX, 
			float *Y, const int incY, const int offsetY)
{

 cblas_saxpy(N, alpha, X+offsetX, incX, Y+offsetY, incY);
}


void cblas_diaxpy(const int N, const double alpha, 
			const double *X, const int incX, const int offsetX, 
			double *Y, const int incY, const int offsetY)
{

 cblas_daxpy(N, alpha, X+offsetX, incX, Y+offsetY, incY);
}


void cblas_ciaxpy(const int N, const CCOMPLEX *alpha, 
			const CCOMPLEX *X, const int incX, const int offsetX, 
			CCOMPLEX *Y, const int incY, const int offsetY)
{
 cblas_caxpy(N, alpha, X+(2*offsetX), incX, Y+(2*offsetY), incY);
}


void cblas_ziaxpy(const int N, const ZCOMPLEX *alpha, 
			const ZCOMPLEX *X, const int incX, const int offsetX, 
			ZCOMPLEX *Y, const int incY, const int offsetY)
{
 cblas_zaxpy(N, alpha, X+(2*offsetX), incX, Y+(2*offsetY), incY);
}
EOF
)


(define RowMajor  CblasRowMajor)
(define ColMajor  CblasColMajor)
(define NoTrans   CblasNoTrans)
(define Trans     CblasTrans)
(define ConjTrans CblasConjTrans)
(define Upper     CblasUpper)
(define Lower     CblasLower)
(define NonUnit   CblasNonUnit)
(define Unit      CblasUnit)
(define Left      CblasLeft)
(define Right     CblasRight)


(define (scopy x)
  (let ((n (f32vector-length x)))
    (let ((y  (make-f32vector n)))
      (cblas_scopy n x 1 y 1)
      y)))

(define (dcopy x)
  (let ((n (f64vector-length x)))
    (let ((y  (make-f64vector n)))
      (cblas_dcopy n x 1 y 1)
      y)))

(define (ccopy x)
  (let ((n (fx/ (f32vector-length x) 2)))
    (let ((y  (make-f32vector (fx* 2 n))))
      (cblas_ccopy n x 1 y 1)
      y)))

(define (zcopy x)
  (let ((n (fx/ (f64vector-length x) 2)))
    (let ((y  (make-f64vector (fx* 2 n))))
      (cblas_zcopy n x 1 y 1)
      y)))


(define-syntax icopy-wrapper
  (lambda (x r c)
    (let* ((copy            (cadr x))
	   (vector-length   (caddr x))
	   (make-vector     (cadddr x))
	   (name            copy)
	   (%define         (r 'define))
	   (%let            (r 'let))
	   (%cond           (r 'cond))
	   (%or             (r 'or))
	   (%if             (r 'if))
	   (%let-optionals  (r 'let-optionals)))
	  
    `(,%define (,name n x . rest)
       (,%let-optionals rest ((y #f) (offsetX 0) (offsetY 0) (incX 1) (incY 1))
         (,%let ((xlen  (,vector-length x))
	       (ylen (,%if y (,vector-length y) (fx- n offsetX))))
	     (,%cond ((not (fx= n xlen))
		    (blas:error ',name " n is not equal to the length of X (" xlen ")"))
		   ((fx< offsetX 0) 
		    (blas:error ',name "offset of vector X (" offsetX ") is negative"))
		   ((fx>= offsetX xlen)
		    (blas:error ',name "offset of vector X (" offsetX ") is greater than or equal to its length: " xlen))
		   ((fx< offsetX 0) 
		    (blas:error ',name "offset of vector X (" offsetX ") is negative"))
		   ((fx>= offsetY ylen)
		    (blas:error ',name "offset of vector Y (" offsetY ") is greater than or equal to its length: " ylen))
		   ((fx> (- ylen offsetY) (- xlen offsetX))
		    (blas:error ',name "range of vector Y (" (- ylen offsetY) 
				") is greater than range of vector X: " ( - xlen offsetX))))
	     (,%let ((y (,%or y (,make-vector ylen))))
	       (,copy n x incX offsetX y incY offsetY)
	       y))))))
  )

(icopy-wrapper sicopy f32vector-length make-f32vector)
(icopy-wrapper dicopy f64vector-length make-f64vector)
(icopy-wrapper cicopy 
	       (lambda (x) (fx/ (f32vector-length x) 2))
	       (lambda (n) (make-f32vector (fx* 2 n))))
(icopy-wrapper zicopy 
	       (lambda (x) (fx/ (f64vector-length x) 2))
	       (lambda (n) (make-f64vector (fx* 2 n))))





(bind* #<<EOF

/*
 * ===========================================================================
 * Prototypes for level 1 BLAS functions (complex are recast as routines)
 * ===========================================================================
 */
float  cblas_sdsdot(const int N, const float alpha, const float *X,
                    const int incX, const float *Y, const int incY);
double cblas_dsdot(const int N, const float *X, const int incX, const float *Y,
                   const int incY);
float  cblas_sdot(const int N, const float  *X, const int incX,
                  const float  *Y, const int incY);
double cblas_ddot(const int N, const double *X, const int incX,
                  const double *Y, const int incY);

/*
 * Functions having prefixes Z and C only
 */
void   cblas_cdotu_sub(const int N, const CCOMPLEX *X, const int incX,
                       const CCOMPLEX *Y, const int incY, CCOMPLEX *dotu);
void   cblas_cdotc_sub(const int N, const CCOMPLEX *X, const int incX,
                       const CCOMPLEX *Y, const int incY, CCOMPLEX *dotc);

void   cblas_zdotu_sub(const int N, const ZCOMPLEX *X, const int incX,
                       const ZCOMPLEX *Y, const int incY, ZCOMPLEX *dotu);
void   cblas_zdotc_sub(const int N, const ZCOMPLEX *X, const int incX,
                       const ZCOMPLEX *Y, const int incY, ZCOMPLEX *dotc);


/*
 * Functions having prefixes S D SC DZ
 */
float  cblas_snrm2(const int N, const float *X, const int incX);
float  cblas_sasum(const int N, const float *X, const int incX);

double cblas_dnrm2(const int N, const double *X, const int incX);
double cblas_dasum(const int N, const double *X, const int incX);

float  cblas_scnrm2(const int N, const CCOMPLEX *X, const int incX);
float  cblas_scasum(const int N, const CCOMPLEX *X, const int incX);

double cblas_dznrm2(const int N, const ZCOMPLEX *X, const int incX);
double cblas_dzasum(const int N, const ZCOMPLEX *X, const int incX);



/*
 * Functions having standard 4 prefixes (S D C Z)
 */
CBLAS_INDEX cblas_isamax(const int N, const float  *X, const int incX);
CBLAS_INDEX cblas_idamax(const int N, const double *X, const int incX);
CBLAS_INDEX cblas_icamax(const int N, const void   *X, const int incX);
CBLAS_INDEX cblas_izamax(const int N, const void   *X, const int incX);

/*
 * ===========================================================================
 * Prototypes for level 2 BLAS
 * ===========================================================================
 */

/* 
 * Routines with standard 4 prefixes (S, D, C, Z)
 */
void cblas_sgemv(const enum CBLAS_ORDER order,
                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
                 const float alpha, const float *A, const int lda,
                 const float *X, const int incX, const float beta,
                 float *Y, const int incY);
void cblas_sgbmv(const enum CBLAS_ORDER order,
                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
                 const int KL, const int KU, const float alpha,
                 const float *A, const int lda, const float *X,
                 const int incX, const float beta, float *Y, const int incY);
void cblas_strmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const float *A, const int lda, 
                 float *X, const int incX);
void cblas_stbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const float *A, const int lda, 
                 float *X, const int incX);
void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const float *Ap, float *X, const int incX);
void cblas_strsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const float *A, const int lda, float *X,
                 const int incX);
void cblas_stbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const float *A, const int lda,
                 float *X, const int incX);
void cblas_stpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const float *Ap, float *X, const int incX);

void cblas_dgemv(const enum CBLAS_ORDER order,
                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
                 const double alpha, const double *A, const int lda,
                 const double *X, const int incX, const double beta,
                 double *Y, const int incY);
void cblas_dgbmv(const enum CBLAS_ORDER order,
                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
                 const int KL, const int KU, const double alpha,
                 const double *A, const int lda, const double *X,
                 const int incX, const double beta, double *Y, const int incY);
void cblas_dtrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const double *A, const int lda, 
                 double *X, const int incX);
void cblas_dtbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const double *A, const int lda, 
                 double *X, const int incX);
void cblas_dtpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const double *Ap, double *X, const int incX);
void cblas_dtrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const double *A, const int lda, double *X,
                 const int incX);
void cblas_dtbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const double *A, const int lda,
                 double *X, const int incX);
void cblas_dtpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const double *Ap, double *X, const int incX);

void cblas_cgemv(const enum CBLAS_ORDER order,
                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
                 const CCOMPLEX *alpha, const CCOMPLEX *A, const int lda,
                 const CCOMPLEX *X, const int incX, const CCOMPLEX *beta,
                 CCOMPLEX *Y, const int incY);
void cblas_cgbmv(const enum CBLAS_ORDER order,
                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
                 const int KL, const int KU, const CCOMPLEX *alpha,
                 const CCOMPLEX *A, const int lda, const CCOMPLEX *X,
                 const int incX, const CCOMPLEX *beta, CCOMPLEX *Y, const int incY);
void cblas_ctrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const CCOMPLEX *A, const int lda, 
                 CCOMPLEX *X, const int incX);
void cblas_ctbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const CCOMPLEX *A, const int lda, 
                 CCOMPLEX *X, const int incX);
void cblas_ctpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const CCOMPLEX *Ap, CCOMPLEX *X, const int incX);
void cblas_ctrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const CCOMPLEX *A, const int lda, CCOMPLEX *X,
                 const int incX);
void cblas_ctbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const CCOMPLEX *A, const int lda,
                 CCOMPLEX *X, const int incX);
void cblas_ctpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const CCOMPLEX *Ap, CCOMPLEX *X, const int incX);

void cblas_zgemv(const enum CBLAS_ORDER order,
                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
                 const ZCOMPLEX *alpha, const ZCOMPLEX *A, const int lda,
                 const ZCOMPLEX *X, const int incX, const ZCOMPLEX *beta,
                 ZCOMPLEX *Y, const int incY);
void cblas_zgbmv(const enum CBLAS_ORDER order,
                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
                 const int KL, const int KU, const ZCOMPLEX *alpha,
                 const ZCOMPLEX *A, const int lda, const ZCOMPLEX *X,
                 const int incX, const ZCOMPLEX *beta, ZCOMPLEX *Y, const int incY);
void cblas_ztrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const ZCOMPLEX *A, const int lda, 
                 ZCOMPLEX *X, const int incX);
void cblas_ztbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const ZCOMPLEX *A, const int lda, 
                 ZCOMPLEX *X, const int incX);
void cblas_ztpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const ZCOMPLEX *Ap, ZCOMPLEX *X, const int incX);
void cblas_ztrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const ZCOMPLEX *A, const int lda, ZCOMPLEX *X,
                 const int incX);
void cblas_ztbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const ZCOMPLEX *A, const int lda,
                 ZCOMPLEX *X, const int incX);
void cblas_ztpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
                 const int N, const ZCOMPLEX *Ap, ZCOMPLEX *X, const int incX);


/* 
 * Routines with S and D prefixes only
 */
void cblas_ssymv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const float alpha, const float *A,
                 const int lda, const float *X, const int incX,
                 const float beta, float *Y, const int incY);
void cblas_ssbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const int K, const float alpha, const float *A,
                 const int lda, const float *X, const int incX,
                 const float beta, float *Y, const int incY);
void cblas_sspmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const float alpha, const float *Ap,
                 const float *X, const int incX,
                 const float beta, float *Y, const int incY);
void cblas_sger(const enum CBLAS_ORDER order, const int M, const int N,
                const float alpha, const float *X, const int incX,
                const float *Y, const int incY, float *A, const int lda);
void cblas_ssyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const float alpha, const float *X,
                const int incX, float *A, const int lda);
void cblas_sspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const float alpha, const float *X,
                const int incX, float *Ap);
void cblas_ssyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const float alpha, const float *X,
                const int incX, const float *Y, const int incY, float *A,
                const int lda);
void cblas_sspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const float alpha, const float *X,
                const int incX, const float *Y, const int incY, float *A);

void cblas_dsymv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const double alpha, const double *A,
                 const int lda, const double *X, const int incX,
                 const double beta, double *Y, const int incY);
void cblas_dsbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const int K, const double alpha, const double *A,
                 const int lda, const double *X, const int incX,
                 const double beta, double *Y, const int incY);
void cblas_dspmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const double alpha, const double *Ap,
                 const double *X, const int incX,
                 const double beta, double *Y, const int incY);
void cblas_dger(const enum CBLAS_ORDER order, const int M, const int N,
                const double alpha, const double *X, const int incX,
                const double *Y, const int incY, double *A, const int lda);
void cblas_dsyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const double alpha, const double *X,
                const int incX, double *A, const int lda);
void cblas_dspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const double alpha, const double *X,
                const int incX, double *Ap);
void cblas_dsyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const double alpha, const double *X,
                const int incX, const double *Y, const int incY, double *A,
                const int lda);
void cblas_dspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const double alpha, const double *X,
                const int incX, const double *Y, const int incY, double *A);


/* 
 * Routines with C and Z prefixes only
 */
void cblas_chemv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const CCOMPLEX *alpha, const CCOMPLEX *A,
                 const int lda, const CCOMPLEX *X, const int incX,
                 const CCOMPLEX *beta, CCOMPLEX *Y, const int incY);
void cblas_chbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const int K, const CCOMPLEX *alpha, const CCOMPLEX *A,
                 const int lda, const CCOMPLEX *X, const int incX,
                 const CCOMPLEX *beta, CCOMPLEX *Y, const int incY);
void cblas_chpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const CCOMPLEX *alpha, const CCOMPLEX *Ap,
                 const CCOMPLEX *X, const int incX,
                 const CCOMPLEX *beta, CCOMPLEX *Y, const int incY);
void cblas_cgeru(const enum CBLAS_ORDER order, const int M, const int N,
                 const CCOMPLEX *alpha, const CCOMPLEX *X, const int incX,
                 const CCOMPLEX *Y, const int incY, CCOMPLEX *A, const int lda);
void cblas_cgerc(const enum CBLAS_ORDER order, const int M, const int N,
                 const CCOMPLEX *alpha, const CCOMPLEX *X, const int incX,
                 const CCOMPLEX *Y, const int incY, CCOMPLEX *A, const int lda);
void cblas_cher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const float alpha, const CCOMPLEX *X, const int incX,
                CCOMPLEX *A, const int lda);
void cblas_chpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const float alpha, const CCOMPLEX *X,
                const int incX, CCOMPLEX *A);
void cblas_cher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
                const CCOMPLEX *alpha, const CCOMPLEX *X, const int incX,
                const CCOMPLEX *Y, const int incY, CCOMPLEX *A, const int lda);
void cblas_chpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
                const CCOMPLEX *alpha, const CCOMPLEX *X, const int incX,
                const CCOMPLEX *Y, const int incY, CCOMPLEX *Ap);

void cblas_zhemv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const ZCOMPLEX *alpha, const ZCOMPLEX *A,
                 const int lda, const ZCOMPLEX *X, const int incX,
                 const ZCOMPLEX *beta, ZCOMPLEX *Y, const int incY);
void cblas_zhbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const int K, const ZCOMPLEX *alpha, const ZCOMPLEX *A,
                 const int lda, const ZCOMPLEX *X, const int incX,
                 const ZCOMPLEX *beta, ZCOMPLEX *Y, const int incY);
void cblas_zhpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                 const int N, const ZCOMPLEX *alpha, const ZCOMPLEX *Ap,
                 const ZCOMPLEX *X, const int incX,
                 const ZCOMPLEX *beta, ZCOMPLEX *Y, const int incY);
void cblas_zgeru(const enum CBLAS_ORDER order, const int M, const int N,
                 const ZCOMPLEX *alpha, const ZCOMPLEX *X, const int incX,
                 const ZCOMPLEX *Y, const int incY, ZCOMPLEX *A, const int lda);
void cblas_zgerc(const enum CBLAS_ORDER order, const int M, const int N,
                 const ZCOMPLEX *alpha, const ZCOMPLEX *X, const int incX,
                 const ZCOMPLEX *Y, const int incY, ZCOMPLEX *A, const int lda);
void cblas_zher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const double alpha, const ZCOMPLEX *X, const int incX,
                ZCOMPLEX *A, const int lda);
void cblas_zhpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
                const int N, const double alpha, const ZCOMPLEX *X,
                const int incX, ZCOMPLEX *A);
void cblas_zher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
                const ZCOMPLEX *alpha, const ZCOMPLEX *X, const int incX,
                const ZCOMPLEX *Y, const int incY, ZCOMPLEX *A, const int lda);
void cblas_zhpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
                const ZCOMPLEX *alpha, const ZCOMPLEX *X, const int incX,
                const ZCOMPLEX *Y, const int incY, ZCOMPLEX *Ap);

/*
 * ===========================================================================
 * Prototypes for level 3 BLAS
 * ===========================================================================
 */

/* 
 * Routines with standard 4 prefixes (S, D, C, Z)
 */
void cblas_sgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
                 const int K, const float alpha, const float *A,
                 const int lda, const float *B, const int ldb,
                 const float beta, float *C, const int ldc);
void cblas_ssymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const int M, const int N,
                 const float alpha, const float *A, const int lda,
                 const float *B, const int ldb, const float beta,
                 float *C, const int ldc);
void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                 const float alpha, const float *A, const int lda,
                 const float beta, float *C, const int ldc);
void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                  const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                  const float alpha, const float *A, const int lda,
                  const float *B, const int ldb, const float beta,
                  float *C, const int ldc);
void cblas_strmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const float alpha, const float *A, const int lda,
                 float *B, const int ldb);
void cblas_strsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const float alpha, const float *A, const int lda,
                 float *B, const int ldb);

void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
                 const int K, const double alpha, const double *A,
                 const int lda, const double *B, const int ldb,
                 const double beta, double *C, const int ldc);
void cblas_dsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const int M, const int N,
                 const double alpha, const double *A, const int lda,
                 const double *B, const int ldb, const double beta,
                 double *C, const int ldc);
void cblas_dsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                 const double alpha, const double *A, const int lda,
                 const double beta, double *C, const int ldc);
void cblas_dsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                  const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                  const double alpha, const double *A, const int lda,
                  const double *B, const int ldb, const double beta,
                  double *C, const int ldc);
void cblas_dtrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const double alpha, const double *A, const int lda,
                 double *B, const int ldb);
void cblas_dtrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const double alpha, const double *A, const int lda,
                 double *B, const int ldb);

void cblas_cgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
                 const int K, const CCOMPLEX *alpha, const CCOMPLEX *A,
                 const int lda, const CCOMPLEX *B, const int ldb,
                 const CCOMPLEX *beta, CCOMPLEX *C, const int ldc);
void cblas_csymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const int M, const int N,
                 const CCOMPLEX *alpha, const CCOMPLEX *A, const int lda,
                 const CCOMPLEX *B, const int ldb, const CCOMPLEX *beta,
                 CCOMPLEX *C, const int ldc);
void cblas_csyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                 const CCOMPLEX *alpha, const CCOMPLEX *A, const int lda,
                 const CCOMPLEX *beta, CCOMPLEX *C, const int ldc);
void cblas_csyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                  const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                  const CCOMPLEX *alpha, const CCOMPLEX *A, const int lda,
                  const CCOMPLEX *B, const int ldb, const CCOMPLEX *beta,
                  CCOMPLEX *C, const int ldc);
void cblas_ctrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const CCOMPLEX *alpha, const CCOMPLEX *A, const int lda,
                 CCOMPLEX *B, const int ldb);
void cblas_ctrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const CCOMPLEX *alpha, const CCOMPLEX *A, const int lda,
                 CCOMPLEX *B, const int ldb);

void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
                 const int K, const ZCOMPLEX *alpha, const ZCOMPLEX *A,
                 const int lda, const ZCOMPLEX *B, const int ldb,
                 const ZCOMPLEX *beta, ZCOMPLEX *C, const int ldc);
void cblas_zsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const int M, const int N,
                 const ZCOMPLEX *alpha, const ZCOMPLEX *A, const int lda,
                 const ZCOMPLEX *B, const int ldb, const ZCOMPLEX *beta,
                 ZCOMPLEX *C, const int ldc);
void cblas_zsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                 const ZCOMPLEX *alpha, const ZCOMPLEX *A, const int lda,
                 const ZCOMPLEX *beta, ZCOMPLEX *C, const int ldc);
void cblas_zsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                  const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                  const ZCOMPLEX *alpha, const ZCOMPLEX *A, const int lda,
                  const ZCOMPLEX *B, const int ldb, const ZCOMPLEX *beta,
                  ZCOMPLEX *C, const int ldc);
void cblas_ztrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const ZCOMPLEX *alpha, const ZCOMPLEX *A, const int lda,
                 ZCOMPLEX *B, const int ldb);
void cblas_ztrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const ZCOMPLEX *alpha, const ZCOMPLEX *A, const int lda,
                 ZCOMPLEX *B, const int ldb);


/* 
 * Routines with prefixes C and Z only
 */
void cblas_chemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const int M, const int N,
                 const CCOMPLEX *alpha, const CCOMPLEX *A, const int lda,
                 const CCOMPLEX *B, const int ldb, const CCOMPLEX *beta,
                 CCOMPLEX *C, const int ldc);
void cblas_cherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                 const float alpha, const CCOMPLEX *A, const int lda,
                 const float beta, CCOMPLEX *C, const int ldc);
void cblas_cher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                  const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                  const CCOMPLEX *alpha, const CCOMPLEX *A, const int lda,
                  const CCOMPLEX *B, const int ldb, const float beta,
                  CCOMPLEX *C, const int ldc);

void cblas_zhemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const int M, const int N,
                 const ZCOMPLEX *alpha, const ZCOMPLEX *A, const int lda,
                 const ZCOMPLEX *B, const int ldb, const ZCOMPLEX *beta,
                 ZCOMPLEX *C, const int ldc);
void cblas_zherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                 const double alpha, const ZCOMPLEX *A, const int lda,
                 const double beta, ZCOMPLEX *C, const int ldc);
void cblas_zher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                  const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                  const ZCOMPLEX *alpha, const ZCOMPLEX *A, const int lda,
                  const ZCOMPLEX *B, const int ldb, const double beta,
                  ZCOMPLEX *C, const int ldc);


/* Offset variants of ger routines */

void cblas_siger(const enum CBLAS_ORDER order, const int M, const int N,
		       const float alpha, 
		       const float *X, const int incX, const int offsetX,
		       const float *Y, const int incY, const int offsetY,
		       float *A, const int lda)
{

 cblas_sger(order, M, N, alpha, X+offsetX, incX, Y+offsetY, incY, A, lda);
}

void cblas_diger(const enum CBLAS_ORDER order, const int M, const int N,
		       const double alpha, 
		       const double *X, const int incX, const int offsetX,
		       const double *Y, const int incY, const int offsetY,
		       double *A, const int lda)
{

 cblas_dger(order, M, N, alpha, X+offsetX, incX, Y+offsetY, incY, A, lda);
}


/* "Standardize" some procedure names */

float  cblas_cnrm2(const int N, const CCOMPLEX *X, const int incX)
{
 return cblas_scnrm2(N,X,incX);
}

double cblas_znrm2(const int N, const ZCOMPLEX *X, const int incX)
{
 return cblas_dznrm2(N,X,incX);
}


float  cblas_casum(const int N, const CCOMPLEX *X, const int incX)
{
  return cblas_scasum(N,X,incX);
}

double  cblas_zasum(const int N, const ZCOMPLEX *X, const int incX)
{
  return cblas_dzasum(N,X,incX);
}

CBLAS_INDEX cblas_samax(const int N, const float  *X, const int incX)
{
 return cblas_isamax(N,X,incX);
}

CBLAS_INDEX cblas_damax(const int N, const double *X, const int incX)
{
 return cblas_idamax(N,X,incX);
}

CBLAS_INDEX cblas_camax(const int N, const void   *X, const int incX)
{
 return cblas_icamax(N,X,incX);
}

CBLAS_INDEX cblas_zamax(const int N, const void   *X, const int incX)
{
 return cblas_izamax(N,X,incX);
}

void   cblas_cdotu(const int N, const CCOMPLEX *X, const int incX,
			 const CCOMPLEX *Y, const int incY, CCOMPLEX *dotu)
{
 cblas_cdotu_sub(N,X,incX,Y,incY,dotu);
}

void   cblas_cdotc(const int N, const CCOMPLEX *X, const int incX,
			 const CCOMPLEX *Y, const int incY, CCOMPLEX *dotc)
{
 cblas_cdotc_sub(N,X,incX,Y,incY,dotc);
}

void   cblas_zdotu(const int N, const ZCOMPLEX *X, const int incX,
                       const ZCOMPLEX *Y, const int incY, ZCOMPLEX *dotu)
{
 cblas_zdotu_sub(N,X,incX,Y,incY,dotu);
}

void   cblas_zdotc(const int N, const ZCOMPLEX *X, const int incX,
                       const ZCOMPLEX *Y, const int incY, ZCOMPLEX *dotc)
{
 cblas_zdotc_sub(N,X,incX,Y,incY,dotc);
}
EOF
)



(define-syntax blas-level3-wrap
      (lambda (x r c)
	(let* ((fn      (cadr x))
	       (ret     (caddr x))
	       (err     (cadddr x))
	       (vsize   (car (cddddr x)))
	       (copy    (cadr (cddddr x)))
	       (cfname  (string->symbol (conc "cblas_" (symbol->string (car fn)))))
	       (fname   (string->symbol (conc (if vsize "" "unsafe-") 
					      (symbol->string (car fn))
					      (if copy "" "!"))))
	       (%define         (r 'define))
	       (%begin          (r 'begin))
	       (%let            (r 'let))
	       (%cond           (r 'cond))
	       (%or             (r 'or))
	       (%if             (r 'if))
	       (%let-optionals  (r 'let-optionals))
	       
	       (ka              (r 'ka))
	       (kb              (r 'kb))
	       (kc              (r 'kc))
	       (asize           (r 'asize))
	       (bsize           (r 'bsize))
	       (csize           (r 'csize))
	       
	       (args   (reverse (cdr fn)))

	       (fsig  (let loop ((args args) (sig 'rest))
			(if (null? args) (cons fname sig)
			    (let ((x (car args)))
			      (let ((sig (case x 
					  ((lda)     sig)
					  ((ldb)     sig)
					  ((ldc)     sig)
					  (else      (cons x sig)))))
				(loop (cdr args) sig))))))

	       (opts  (append 
		       (if (memq 'lda fn)  
			   `((lda 
			      ,(cond ((memq 'side fn)
				      `(,%if (= side Left) m n))
				     ((memq 'transA fn)
				      `(,%if (= transA NoTrans) k ,(if (memq 'm fn) 'm 'n)))
				     ((memq 'trans fn)
				      `(,%if (= trans NoTrans) k n))
				     (else   
				      (cond ((memq 'm fn) 'm) 
					    (else 'n))))))
			   `())
		       (if (memq 'ldb fn)   
			   `((ldb ,(cond ((memq 'transB fn) 
					  `(,%if (= transB NoTrans) n k))
					 ((memq 'trans fn) 
					  `(,%if (= trans NoTrans) k n))
					 (else 'n))))
			   `())
		       (if (memq 'ldc fn)  
			   `((ldc  n)) `()))))

	  `(,%define ,fsig 
		     (,%let-optionals rest ,opts
		      ,(if vsize
			   `(,%begin
			     (,%let ((,asize (,vsize a))
				     (,ka    ,(cond ((memq 'side fn) 
						     `(,%if (= side Left) m n))
						    ((memq 'transA fn) 
						     `(,%if (= transA NoTrans) 
							    ,(if (memq 'm fn) 'm 'n) k))
						    ((memq 'trans fn) 
						     `(,%if (= trans NoTrans) 
							    ,(if (memq 'm fn) 'm 'n) k))
						    (else (if (memq 'm fn) 'm 'n)))))
				    (,%if (< ,asize (fx* lda ,ka)) 
					  (blas:error ',fname (conc "matrix A is allocated " ,asize " elements "
								    "but given dimensions are " ,ka " by " lda))))
			     ,(if (memq 'b fn)
				  `(,%let ((,bsize (,vsize b))
					   (,kb    ,(cond ((memq 'transB fn) 
							   `(,%if (= transB NoTrans) k n))
							  ((memq 'trans fn) 
							   `(,%if (= trans NoTrans) n k))
							  (else 'm))))
					  (,%if (< ,bsize (fx* ldb ,kb)) 
						(blas:error ',fname (conc "matrix B is allocated " ,bsize " elements "
									  "but given dimensions are " ,kb " by " ldb))))
				  `(begin))
			     ,(if (memq 'c fn)
				  `(let ((,csize (,vsize c))
					 (,kc    ,(if (memq 'm fn) 'm 'n)))
				     (if (< ,csize (fx* ldc ,kc))
					 (blas:error ',fname (conc "matrix C is allocated " ,csize " elements "
								   "but given dimensions are " ,kc " by " ldc))))
				  `(begin)))
			   `(begin))
		      (,%let ,(let loop ((fn fn) (bnds '()))
				(if (null? fn) bnds
				    (let ((x (car fn)))
				      (let ((bnds (case x 
						    (else    (if (and copy ret (memq x ret))
								 (cons `(,x (,copy ,x)) bnds)
								 bnds)))))
					(loop (cdr fn) bnds)))))
			     (,%begin (,cfname . ,(cdr fn))
				      (values . ,ret)))))))
)

     
(define-syntax blas-level3-wrapx 
   (lambda (x r c)
     (let* ((fn     (cadr x))
	    (ret    (caddr x))
	    (errs   (cadddr x)))
       
       `(begin
	 (blas-level3-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs #f #f)
	 (blas-level3-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs #f #f)
	 (blas-level3-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs #f #f)
	 (blas-level3-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs #f #f)
	 
	 (blas-level3-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs f32vector-length #f)
	 (blas-level3-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs f64vector-length #f)
	 (blas-level3-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) #f)
	 (blas-level3-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) #f)
	 
	 (blas-level3-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs f32vector-length  scopy)
	 (blas-level3-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs f64vector-length  dcopy)
	 (blas-level3-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) ccopy)
	 (blas-level3-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) zcopy))))

   )


(define-syntax blas-level3-cz-wrapx
   (lambda (x r c)
     (let* ((fn      (cadr x))
	    (ret     (caddr x))
	    (errs    (cadddr x)))
       
       `(begin
	 (blas-level3-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs #f #f)
	 (blas-level3-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs #f #f)
	 
	 (blas-level3-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) #f)
	 (blas-level3-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) #f)
	 
	 (blas-level3-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) ccopy)
	 (blas-level3-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			   ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) zcopy))))
  )


(blas-level3-wrapx (gemm order transA transB m n k alpha a lda b ldb beta c ldc)
		     (c)
		     (lambda (i) (cond ((= i 3)  "M < 0")
				       ((= i 4)  "N < 0")
				       ((= i 5)  "K < 0")
				       ((= i 8)  "LDA < max(1, M or K)")
				       ((= i 10) "LDB < max(1, N or K)")
				       ((= i 13) "LDC < max(1, M)")
				       (else (conc "error code " i)))))
  
  (blas-level3-wrapx (symm order side uplo  m n alpha a lda b ldb beta c ldc)
		     (c)
		     (lambda (i) (cond ((= i 3)  "M < 0")
				     ((= i 4)  "N < 0")
				     ((= i 5)  "K < 0")
				     ((= i 8)  "LDA < max(1, M or K)")
				     ((= i 10) "LDB < max(1, N or K)")
				     ((= i 13) "LDC < max(1, M)")
				     (else (conc "error code " i)))))
  
  (blas-level3-cz-wrapx (hemm order side uplo  m n alpha a lda b ldb beta c ldc)
			(c)
			(lambda (i) (cond ((= i 3)  "M < 0")
					  ((= i 4)  "N < 0")
					  ((= i 5)  "K < 0")
					  ((= i 8)  "LDA < max(1, M or K)")
					  ((= i 10) "LDB < max(1, N or K)")
					  ((= i 13) "LDC < max(1, M)")
					  (else (conc "error code " i)))))
  
  (blas-level3-wrapx (syrk order uplo trans n k alpha a lda beta c ldc)
		     (c)
		     (lambda (i) (cond ((= i 3)  "M < 0")
				       ((= i 4)  "N < 0")
				       ((= i 5)  "K < 0")
				       ((= i 8)  "LDA < max(1, M or K)")
				       ((= i 10) "LDB < max(1, N or K)")
				       ((= i 13) "LDC < max(1, M)")
				       (else (conc "error code " i)))))
  
  (blas-level3-cz-wrapx (herk order uplo trans n k alpha a lda beta c ldc)
			(c)
			(lambda (i) (cond ((= i 3)  "M < 0")
					  ((= i 4)  "N < 0")
					  ((= i 5)  "K < 0")
					  ((= i 8)  "LDA < max(1, M or K)")
					  ((= i 10) "LDB < max(1, N or K)")
					  ((= i 13) "LDC < max(1, M)")
					  (else (conc "error code " i)))))
  
  
  (blas-level3-wrapx (syr2k order uplo trans n k alpha a lda b ldb beta c ldc)
		     (c)
		     (lambda (i) (cond ((= i 3)  "M < 0")
				       ((= i 4)  "N < 0")
				       ((= i 5)  "K < 0")
				       ((= i 8)  "LDA < max(1, M or K)")
				       ((= i 10) "LDB < max(1, N or K)")
				       ((= i 13) "LDC < max(1, M)")
				       (else (conc "error code " i)))))
  
  (blas-level3-cz-wrapx (her2k order uplo trans n k alpha a lda b ldb beta c ldc)
			(c)
			(lambda (i) (cond ((= i 3)  "M < 0")
					  ((= i 4)  "N < 0")
					  ((= i 5)  "K < 0")
					  ((= i 8)  "LDA < max(1, M or K)")
					  ((= i 10) "LDB < max(1, N or K)")
					  ((= i 13) "LDC < max(1, M)")
					  (else (conc "error code " i)))))
  
  (blas-level3-wrapx (trmm order side uplo transA diag m n alpha a lda b ldb)
		     (b)
		     (lambda (i) (cond ((= i 3)  "M < 0")
				       ((= i 4)  "N < 0")
				       ((= i 5)  "K < 0")
				       ((= i 8)  "LDA < max(1, M or K)")
				       ((= i 10) "LDB < max(1, N or K)")
				       ((= i 13) "LDC < max(1, M)")
				       (else (conc "error code " i)))))
  
  
  (blas-level3-wrapx (trsm order side uplo transA diag m n alpha a lda b ldb)
		     (b)
		     (lambda (i) (cond ((= i 3)  "M < 0")
				       ((= i 4)  "N < 0")
				       ((= i 5)  "K < 0")
				       ((= i 8)  "LDA < max(1, M or K)")
				       ((= i 10) "LDB < max(1, N or K)")
				       ((= i 13) "LDC < max(1, M)")
				       (else (conc "error code " i)))))
     


(define-syntax blas-level2-wrap
      (lambda (x r c)
	(let* ((fn      (cadr x))
	       (ret     (caddr x))
	       (err     (cadddr x))
	       (vsize   (car (cddddr x)))
	       (copy    (cadr (cddddr x)))
	       (cfname  (string->symbol (conc "cblas_" (symbol->string (car fn)))))
	       (fname   (string->symbol (conc (if vsize "" "unsafe-") 
					      (symbol->string (car fn))
					      (if copy "" "!"))))
	       (%define         (r 'define))
	       (%begin          (r 'begin))
	       (%let            (r 'let))
	       (%cond           (r 'cond))
	       (%or             (r 'or))
	       (%if             (r 'if))
	       (%let-optionals  (r 'let-optionals))

	       (ka              (r 'ka))
	       (asize           (r 'asize))
	       (apsize          (r 'apsize))
	       (apdim           (r 'apdim))
	       (xsize           (r 'xsize))
	       (ysize           (r 'ysize))
	       (xdim            (r 'xdim))
	       (ydim            (r 'ydim))

	       (args  (reverse (cdr fn)))

	       (fsig  (let loop ((args args) (sig 'rest))
			(if (null? args) (cons fname sig)
			    (let ((x (car args)))
			      (let ((sig (case x
					  ((lda)      sig)
					  ((incx)     sig)
					  ((incy)     sig)
					  ((offx)     sig)
					  ((offy)     sig)
					  (else      (cons x sig)))))
				(loop (cdr args) sig))))))

	       (opts  (append 
		       (if (memq 'lda fn)  `((lda  ,(cond ((memq 'k fn) `(fx+ 1 k))
							  (else 'n)))) `())
		       (if (memq 'incy fn) `((incx 1) (incy 1) (offx 0) (offy 0)) `((incx 1)))))
	       )

      `(,%define ,fsig 
	 (,%let-optionals rest ,opts
 	  ,(if vsize
	       `(,%begin
		  ,(if (memq 'a fn)
		       `(,%let ((,asize (,vsize a))
				(,ka    ,(if (memq 'm fn) 'm 'n)))
			  (,%if (< ,asize (fx* lda ,ka))
			      (blas:error ',fname (conc "matrix A is allocated " ,asize " elements "
							"but given dimensions are " ,ka " by " lda))))
		       `(begin))
		  ,(if (memq 'ap fn)
		       `(,%let ((,apsize (,vsize ap))
				(,apdim  (fx/ (fx* n (fx+ n 1)) 2)))
			  (,%if (< ,apsize ,apdim)
				(blas:error ',fname (conc "vector Ap is allocated " ,apsize " elements "
							  "but given dimension is " ,apdim))))
		       `(begin))
		  ,(if (memq 'y fn)
		       `(,%let ((,ysize (,vsize y))
				(,ydim  ,(if (and (memq 'm fn) (memq 'trans fn))
					     `(,%if (= trans NoTrans) 
						    (fx+ 1 (fx* (abs incy) (fx- (fx+ offy m) 1)))
						    (fx+ 1 (fx* (abs incy) (fx- (fx+ offy n) 1))))
					     `(fx+ 1 (fx* (abs incy) (fx- n 1))))))
			  (,%if (< ,ysize ,ydim)
				(blas:error ',fname (conc "vector Y is allocated " ,ysize " elements "
							  "but given dimension is " ,ydim))))
		       `(begin))
		  ,(if (memq 'x fn)
		       `(,%let ((,xsize (,vsize x))
				(,xdim  ,(if (and (memq 'm fn) (memq 'trans fn))
					     `(if (= trans NoTrans) 
						  (fx+ 1 (fx* (abs incx) (fx- (fx+ offx n) 1)))
						  (fx+ 1 (fx* (abs incx) (fx- (fx+ offx m) 1))))
					     `(fx+ 1 (fx* (abs incx) (fx- n 1))))))
			  (,%if (< ,xsize ,xdim)
				(blas:error ',fname (conc "vector X is allocated " ,xsize " elements "
							  "but given dimension is " ,xdim))))
		       `(begin)))
	       `(begin))
	  (let ,(let loop ((fn fn) (bnds '()))
		  (if (null? fn) bnds
		      (let ((x (car fn)))
			(let ((bnds (case x 
				      (else    (if (and copy ret (memq x ret))
						   (cons `(,x (,copy ,x)) bnds)
						   bnds)))))
			  (loop (cdr fn) bnds)))))
	    (begin (,cfname . ,(cdr fn))
		   (values . ,ret)))))))
)


(define-syntax blas-level2-wrapx
      (lambda (x r c)
	(let* ((fn      (cadr x))
	       (ret     (caddr x))
	       (errs    (cadddr x)))
	  
	  `(begin
	    (blas-level2-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs #f #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs #f #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs #f #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs #f #f)
	    
	    (blas-level2-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs f32vector-length #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs f64vector-length #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) #f)
	    
	    (blas-level2-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs f32vector-length  scopy)
	    (blas-level2-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs f64vector-length  dcopy)
	    (blas-level2-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) ccopy)
	    (blas-level2-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) zcopy)))
	))

     
(define-syntax blas-level2-sd-wrapx
      (lambda (x r c)
	(let* ((fn      (cadr x))
	       (ret     (caddr x))
	       (errs    (cadddr x)))
	  
	  `(begin
	    (blas-level2-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs #f #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs #f #f)
	    
	    (blas-level2-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs f32vector-length #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs f64vector-length #f)
	    
	    (blas-level2-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs f32vector-length  scopy)
	    (blas-level2-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs f64vector-length  dcopy))))
)
 
    
(define-syntax blas-level2-cz-wrapx
      (lambda (x r c)
	(let* ((fn      (cadr x))
	       (ret     (caddr x))
	       (errs    (cadddr x)))
	  
	  `(begin
	    (blas-level2-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs #f #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs #f #f)
	    
	    (blas-level2-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) #f)
	    (blas-level2-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) #f)
	    
	    (blas-level2-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) ccopy)
	    (blas-level2-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
			      ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) zcopy))))
)
     
     
(blas-level2-wrapx (gemv order trans m n alpha a lda x incx beta y incy)
		     (y)
		     (lambda (i) (cond ((= i 2)  "M < 0")
				       ((= i 3)  "N < 0")
				       ((= i 6)  "LDA < max(1, M)")
				       ((= i 8)  "INCX = 0")
				       ((= i 11) "INCY < = 0")
				       (else (conc "error code " i)))))
  
(blas-level2-cz-wrapx (hemv order uplo n alpha a lda x incx beta y incy)
		      (y)
		      (lambda (i) (cond ((= i 2)  "M < 0")
					((= i 3)  "N < 0")
					((= i 6)  "LDA < max(1, M)")
					((= i 8)  "INCX = 0")
					((= i 11) "INCY < = 0")
					(else (conc "error code " i)))))

(blas-level2-cz-wrapx (hbmv order uplo n k alpha a lda x incx beta y incy)
		      (y)
		      (lambda (i) (cond ((= i 2)  "M < 0")
					((= i 3)  "N < 0")
					((= i 6)  "LDA < max(1, M)")
					((= i 8)  "INCX = 0")
					((= i 11) "INCY < = 0")
					(else (conc "error code " i)))))

(blas-level2-cz-wrapx (hpmv order uplo n alpha ap x incx beta y incy)
		      (y)
		      (lambda (i) (cond ((= i 2)  "M < 0")
					((= i 3)  "N < 0")
					((= i 6)  "LDA < max(1, M)")
					((= i 8)  "INCX = 0")
					((= i 11) "INCY < = 0")
					(else (conc "error code " i)))))

(blas-level2-sd-wrapx (symv order uplo n alpha a lda x incx beta y incy)
		      (y)
		      (lambda (i) (cond ((= i 2)  "M < 0")
					((= i 3)  "N < 0")
					((= i 6)  "LDA < max(1, M)")
					((= i 8)  "INCX = 0")
					((= i 11) "INCY < = 0")
					(else (conc "error code " i)))))

(blas-level2-sd-wrapx (sbmv order uplo n k alpha a lda x incx beta y incy)
		      (y)
		      (lambda (i) (cond ((= i 2)  "M < 0")
					((= i 3)  "N < 0")
					((= i 6)  "LDA < max(1, M)")
					((= i 8)  "INCX = 0")
					((= i 11) "INCY < = 0")
					(else (conc "error code " i)))))

(blas-level2-sd-wrapx (spmv order uplo n alpha ap x incx beta y incy)
		      (y)
		      (lambda (i) (cond ((= i 2)  "M < 0")
					((= i 3)  "N < 0")
					((= i 6)  "LDA < max(1, M)")
					((= i 8)  "INCX = 0")
					((= i 11) "INCY < = 0")
					(else (conc "error code " i)))))

(blas-level2-wrapx (trmv order uplo trans diag n a lda x incx)
		   (x)
		   (lambda (i) (cond ((= i 2)  "M < 0")
				     ((= i 3)  "N < 0")
				     ((= i 6)  "LDA < max(1, M)")
				     ((= i 8)  "INCX = 0")
				     ((= i 11) "INCY < = 0")
				     (else (conc "error code " i)))))

(blas-level2-wrapx (tbmv order uplo trans diag n k a lda x incx)
		   (x)
		   (lambda (i) (cond ((= i 2)  "M < 0")
				     ((= i 3)  "N < 0")
				     ((= i 6)  "LDA < max(1, M)")
				     ((= i 8)  "INCX = 0")
				     ((= i 11) "INCY < = 0")
				     (else (conc "error code " i)))))

(blas-level2-wrapx (tpmv order uplo trans diag n ap x incx)
		   (x)
		   (lambda (i) (cond ((= i 2)  "M < 0")
				     ((= i 3)  "N < 0")
				     ((= i 6)  "LDA < max(1, M)")
				     ((= i 8)  "INCX = 0")
				     ((= i 11) "INCY < = 0")
				     (else (conc "error code " i)))))

(blas-level2-wrapx (trsv order uplo trans diag n a lda x incx)
		   (x)
		   (lambda (i) (cond ((= i 2)  "M < 0")
				     ((= i 3)  "N < 0")
				     ((= i 6)  "LDA < max(1, M)")
				     ((= i 8)  "INCX = 0")
				     ((= i 11) "INCY < = 0")
				     (else (conc "error code " i)))))

  (blas-level2-wrapx (tbsv order uplo trans diag n k a lda x incx)
		     (x)
		     (lambda (i) (cond ((= i 2)  "M < 0")
				       ((= i 3)  "N < 0")
				       ((= i 6)  "LDA < max(1, M)")
				       ((= i 8)  "INCX = 0")
				       ((= i 11) "INCY < = 0")
				       (else (conc "error code " i)))))
  
  (blas-level2-wrapx (tpsv order uplo trans diag n ap x incx)
		     (x)
		     (lambda (i) (cond ((= i 2)  "M < 0")
				       ((= i 3)  "N < 0")
				       ((= i 6)  "LDA < max(1, M)")
				       ((= i 8)  "INCX = 0")
				       ((= i 11) "INCY < = 0")
				       (else (conc "error code " i)))))
  
  (blas-level2-sd-wrapx (ger order m n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (geru order m n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
			      
  (blas-level2-cz-wrapx (gerc order m n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
			      
  (blas-level2-cz-wrapx (her order uplo n alpha x incx a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (hpr order uplo n alpha x incx ap)
			(ap)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (her2 order uplo n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (hpr2 order uplo n alpha x incx y incy ap)
			(ap)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-sd-wrapx (syr order uplo n alpha x incx a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
			      
  (blas-level2-sd-wrapx (spr order uplo n alpha x incx ap)
			(ap)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-sd-wrapx (syr2 order uplo n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-sd-wrapx (ger order m n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-sd-wrapx (iger order m n alpha x incx offx y incy offy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (geru order m n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (gerc order m n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  
  (blas-level2-cz-wrapx (her order uplo n alpha x incx a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (hpr order uplo n alpha x incx ap)
			(ap)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (her2 order uplo n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-cz-wrapx (hpr2 order uplo n alpha x incx y incy ap)
			(ap)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
			      
  (blas-level2-sd-wrapx (syr order uplo n alpha x incx a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-sd-wrapx (spr order uplo n alpha x incx ap)
			(ap)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-sd-wrapx (syr2 order uplo n alpha x incx y incy a lda)
			(a)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
  (blas-level2-sd-wrapx (spr2 order uplo n alpha x incx y incy ap)
			(ap)
			(lambda (i) (cond ((= i 2)  "M < 0")
					  ((= i 3)  "N < 0")
					  ((= i 6)  "LDA < max(1, M)")
					  ((= i 8)  "INCX = 0")
					  ((= i 11) "INCY < = 0")
					  (else (conc "error code " i)))))
  
   


(define-syntax  blas-level1-wrap
      (lambda (x r c)
	(let* ((fn            (cadr x))
	       (ret           (caddr x))
	       (err           (cadddr x))
	       (vsize         (car (cddddr x)))
	       (copy          (cadr (cddddr x)))
	       (make-return   (cddr (cddddr x)))
	       (cfname  (string->symbol (conc "cblas_" (symbol->string (car fn)))))
	       (fname   (string->symbol (conc (if vsize "" "unsafe-") 
					      (symbol->string (car fn))
					      (if copy "" "!"))))
	       
	       (%define         (r 'define))
	       (%begin          (r 'begin))
	       (%let            (r 'let))
	       (%cond           (r 'cond))
	       (%or             (r 'or))
	       (%if             (r 'if))
	       (%let-optionals  (r 'let-optionals))

	       (asize           (r 'asize))
	       (apsize          (r 'apsize))
	       (apdim           (r 'apdim))
	       (xsize           (r 'xsize))
	       (ysize           (r 'ysize))
	       (xdim            (r 'xdim))
	       (ydim            (r 'ydim))
	       (psize           (r 'psize))
	       (pdim            (r 'pdim))

	       (args   (reverse (cdr fn)))

	       (fsig  (let loop ((args args) (sig 'rest))
			(if (null? args) (cons fname sig)
			    (let ((x (car args)))
			      (let ((sig (case x
					  ((incx)     sig)
					  ((incy)     sig)
					  ((dotu)     sig)
					  ((dotc)     sig)
					  ((offx)     sig)
					  ((offy)     sig)
					  (else      (cons x sig)))))
				(loop (cdr args) sig))))))

	       (opts  (cond ((memq 'incy fn)  `((incx 1) (incy 1) (offx 0) (offy 0)))
			    (else `((incx 1) (offx 0))))))

	  `(,%define ,fsig 
		     (,%let-optionals rest ,opts
		      ,(if vsize
			   `(,%begin
			     ,(if (memq 'y fn)
				  `(,%let ((,ysize (,vsize y))
					   (,ydim  (fx+ 1 (fx* (abs incy) (fx- (fx+ offy n) 1)))))
					  (,%if (< ,ysize ,ydim)
						(blas:error ',fname (conc "vector Y is allocated " ,ysize " elements "
									  "but given dimension is " ,ydim))))
				  `(begin))
			     ,(if (memq 'x fn)
				  `(,%let ((,xsize (,vsize x))
					   (,xdim  (fx+ 1 (fx* (abs incx) (fx- (fx+ offx n) 1)))))
					  (,%if (< ,xsize ,xdim)
						(blas:error ',fname (conc "vector X is allocated " ,xsize " elements "
									  "but given dimension is " ,xdim))))
				  `(begin))
			     ,(if (memq 'param fn)
				  `(,%let ((,psize (,vsize param))
					   (,pdim  5))
					  (,%if (< ,psize ,pdim)
						(blas:error ',fname (conc "vector PARAM is allocated " ,psize " elements "
									  "but dimension must be " ,pdim))))
				  `(begin)))
			   
			   `(begin))
		      (let ,(let loop ((fn fn) (bnds '()))
			      (if (null? fn) bnds
				  (let ((x (car fn)))
				    (let ((bnds (cond ((or (eq? x 'dotc) (eq? x 'dotu))
						       (cons `(,x (,(car make-return))) bnds))
						      ((and copy ret (memq x ret))
						       (cons `(,x (,copy ,x)) bnds))
						      (else bnds))))
				      (loop (cdr fn) bnds)))))
			,(cond
			  ((memq 'dotc fn)   `(begin (,cfname . ,(cdr fn))
						     (values dotc)))
			  ((memq 'dotu fn)   `(begin (,cfname . ,(cdr fn))
						     (values dotu)))
			  ((not ret)         `(,cfname . ,(cdr fn)))
			  (else              `(begin (,cfname . ,(cdr fn))
						     (values . ,ret)))))))))
      )


(define-syntax blas-level1-wrapx
       (lambda (x r c) 
	 (let* ((fn      (cadr x))
		(ret     (caddr x))
		(errs    (cadddr x)))
	   
	   (if (not ret)
	       `(begin
		 (blas-level1-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
			       ,ret ,errs f32vector-length  scopy)
		 (blas-level1-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs f64vector-length  dcopy)
		 (blas-level1-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) ccopy)
		 (blas-level1-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) zcopy))
	       
	       `(begin
		 (blas-level1-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs #f #f)
		 (blas-level1-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs #f #f)
		 (blas-level1-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs #f #f)
		 (blas-level1-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs #f #f)
		 
		 (blas-level1-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs f32vector-length #f)
		 (blas-level1-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs f64vector-length #f)
		 (blas-level1-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) #f)
		 (blas-level1-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) #f)
		 
		 (blas-level1-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs f32vector-length  scopy)
		 (blas-level1-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs f64vector-length  dcopy)
		 (blas-level1-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) ccopy)
		 (blas-level1-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
				   ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) zcopy))))
	 ))

(define-syntax blas-level1-sd-wrapx
      (lambda (x r c) 
	(let* ((fn      (cadr x))
	       (ret     (caddr x))
	       (errs    (cadddr x)))
	  (if (not ret)
	      
	      `(begin
		(blas-level1-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs f32vector-length  scopy)
		(blas-level1-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs f64vector-length  dcopy))
	      
	      `(begin
		(blas-level1-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs #f #f)
		(blas-level1-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs #f #f)
	     
		(blas-level1-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs f32vector-length #f)
		(blas-level1-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs f64vector-length #f)
		
		(blas-level1-wrap ,(cons (string->symbol (conc "s" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs f32vector-length  scopy)
		(blas-level1-wrap ,(cons (string->symbol (conc "d" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs f64vector-length  dcopy))))
	))


(define-syntax blas-level1-cz-wrapx
      (lambda (x r c) 
	(let* ((fn      (cadr x))
	       (ret     (caddr x))
	       (errs    (cadddr x)))
	  
	  (if (not ret)
	      `(begin
		(blas-level1-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) 
				  ccopy (lambda () (make-f32vector 2)))
		(blas-level1-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) 
				  zcopy (lambda () (make-f64vector 2))))
	      
	      `(begin
		(blas-level1-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs #f #f)
		(blas-level1-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs #f #f)
		
		(blas-level1-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) #f)
		(blas-level1-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) #f)
		
		(blas-level1-wrap ,(cons (string->symbol (conc "c" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs (lambda (v) (fx/ 2 (f32vector-length v))) ccopy)
		(blas-level1-wrap ,(cons (string->symbol (conc "z" (symbol->string (car fn)))) (cdr fn))
				  ,ret ,errs (lambda (v) (fx/ 2 (f64vector-length v))) zcopy))))
	))
     
     
  (blas-level1-sd-wrapx (rot n x incx y incy c s)
			(x y)
			(lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-sd-wrapx (rotm n x incx y incy param)
			(x y)
			(lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-wrapx (swap n x incx y incy)
		     (x y)
		     (lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-wrapx (scal n alpha x incx)
		     (x)
		     (lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-wrapx (axpy n alpha x incx y incy)
		     (y)
		     (lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-wrapx (iaxpy n alpha x incx offx y incy offy)
		     (y)
		     (lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-sd-wrapx (dot n x incx y incy)
			#f
			(lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-cz-wrapx (dotu n x incx y incy dotu)
			#f
			(lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-cz-wrapx (dotc n x incx y incy dotc)
			#f
			(lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-wrapx (nrm2 n x incx)
		     #f
		     (lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-wrapx (asum n x incx)
		     #f
		     (lambda (i) (cond (conc "error code " i))))
  
  (blas-level1-wrapx (amax n x incx)
		     #f
		     (lambda (i) (cond (conc "error code " i))))


)