Coverage report: /home/ellis/comp/core/ffi/blas/blas.lisp

KindCoveredAll%
expression0451 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; blas.lisp --- BLAS
2
 
3
 ;; BLAS Fortran bindings
4
 
5
 ;;; Code:
6
 (defpackage :blas
7
   (:use :cl :std :log :sb-alien)
8
   (:export :load-openblas :load-blas :load-lapack :load-lapacke :load-cblas
9
    :dgemm
10
    :xdouble
11
    :complex-float
12
    :complex-double
13
    :complex-xdouble))
14
 
15
 (in-package :blas)
16
 
17
 (define-alien-loader openblas "/usr/lib/")
18
 ;; usually just points to libopenblas.so
19
 (define-alien-loader blas "/usr/lib/")
20
 (define-alien-loader cblas "/usr/lib/")
21
 
22
 ;;; CBLAS
23
 ;; these are part of CBLAS
24
 (defar openblas-get-num-threads int)
25
 (defar openblas-set-num-threads-local int (n int))
26
 (defar openblas-get-num-procs int)
27
 (defar openblas-get-config c-string)
28
 (defar openblas-get-corename c-string)
29
 (defar openblas-set-threads-callback-function void (* (function void)))
30
 ;; (defar openblas-setaffinity int (thread-idx int) (cpusetsize size-t) (cpu-set (* cpu-set-t)))
31
 ;; (defar openblas-getaffinity int (thread-idx int) (cpusetsize size-t) (cpu-set (* cpu-set-t)))
32
 (defar openblas-get-parallel int)
33
 (define-alien-enum (openblas-parallel int)
34
   :sequential 0
35
   :thread 1
36
   :openmp 2)
37
 
38
 ;; this is defined literally (no BLASFUNC)
39
 (define-alien-routine ("openblas_set_num_threads_" openblas-set-num-threads) void (n int :copy))
40
 
41
 ;;; Types
42
 ;; FLOATRET = float
43
 ;; blasint = int
44
 ;; BLASLONG = long
45
 ;; BLASULONG unsigned-long
46
 ;; xdouble double?
47
 ;; bfloat16 unsigned-short
48
 
49
 (define-alien-type xdouble (array unsigned-long 2))
50
 (define-alien-type complex-float (array float 2))
51
 (define-alien-type complex-double (array double 2))
52
 (define-alien-type complex-xdouble (array xdouble 2))
53
 (define-alien-type openblas-dojob-callback 
54
   (function void int (* t) int))
55
 (define-alien-type openblas-threads-callback
56
     (function void int (* openblas-dojob-callback) int size-t (* t) int))
57
 
58
 ;;; Shared Macros      
59
 (defmacro defblas (sym ret &rest args)
60
   `(defar (,(concatenate 'string (string-downcase (symbol-name sym)) "_") ,sym) ,ret ,@args))
61
 
62
 #|
63
  XERBLA  is an error handler for the LAPACK routines.
64
  It is called by an LAPACK routine if an input parameter has an
65
  invalid value.  A message is printed and execution stops.
66
 
67
  Installers may consider modifying the STOP statement in order to
68
  call system-specific exception-handling facilities.
69
 |#
70
 (defblas xerbla int
71
   (srname c-string)
72
   (info int :copy)
73
   (nout int))
74
 
75
 ;;; Level 1
76
 (macrolet ((blas5 (sym type ret &rest args)
77
              `(defblas ,sym ,ret 
78
                         (n int :copy) 
79
                         ,@args 
80
                         (x (* ,type)) (incx int :copy) 
81
                         (y (* ,type)) (incy int :copy)))
82
            (blas5s (sym &rest args)
83
              `(blas5 ,sym float void ,@args))
84
            (blas5d (sym &rest args)
85
              `(blas5 ,sym double void ,@args))
86
            (blas5bf16 (sym &rest args)
87
              `(blas5 ,sym unsigned-short void ,@args))
88
            (blas5c (sym &rest args)
89
              `(blas5 ,sym complex-float void ,@args))
90
            (blas5z (sym &rest args)
91
              `(blas5 ,sym complex-double void ,@args))
92
            (blas5q (sym &rest args)
93
              `(blas5 ,sym xdouble void ,@args))
94
            (blas5x (sym &rest args)
95
              `(blas5 ,sym complex-xdouble void ,@args))
96
            (blas3 (sym type ret)
97
              `(defblas ,sym ,ret (n int :copy) (x (* ,type)) (incx int :copy)))
98
            (blas3s (sym ret &rest args)
99
              `(blas3 ,sym float ,ret ,@args))
100
            (blas3d (sym ret &rest args)
101
              `(blas3 ,sym double ,ret ,@args))
102
            (blas3bf16 (sym ret &rest args)
103
              `(blas3 ,sym unsigned-short ,ret ,@args))
104
            (blas3c (sym ret &rest args)
105
              `(blas3 ,sym complex-float ,ret ,@args))
106
            (blas3z (sym ret &rest args)
107
              `(blas3 ,sym complex-double ,ret ,@args))
108
            (blas3q (sym ret &rest args)
109
              `(blas3 ,sym xdouble ,ret ,@args))
110
            (blas3x (sym ret &rest args)
111
              `(blas3 ,sym complex-xdouble ,ret ,@args))
112
            (blas7 (sym type)
113
              `(defblas ,sym void 
114
                         (n int :copy) 
115
                         (x (* ,type)) (incx int :copy) 
116
                         (y (* ,type)) (incy int :copy)
117
                         (za (* ,type)) (zb (* ,type))))
118
            (blas4 (sym type)
119
              `(defblas ,sym void 
120
                         (n int :copy) 
121
                         (a (* ,type)) 
122
                         (x (* ,type)) (incx int :copy)))
123
            (blas4* (sym type)
124
              `(defblas ,sym void 
125
                         (a (* ,type)) 
126
                         (b (* ,type)) 
127
                         (c (* ,type)) 
128
                         (s (* ,type))))
129
            (blas5* (sym type)
130
              `(defblas ,sym void 
131
                         (a (* ,type)) 
132
                         (b (* ,type)) 
133
                         (x (* ,type)) 
134
                         (y (* ,type)) 
135
                         (s (* ,type))))
136
            (blas6 (sym type)
137
              `(defblas ,sym void 
138
                         (n int :copy) 
139
                         (x (* ,type)) (incx int :copy) 
140
                         (y (* ,type)) (incy int :copy) 
141
                         (s (* ,type)))))
142
   (blas5 sdot float float)
143
   (blas5 sdsdot float float (a (* float)))
144
   (blas5 dsdot float double)
145
   (blas5 ddot float double)
146
   (blas5 qdot xdouble xdouble)
147
   (blas5 sbdot unsigned-short float)
148
 
149
   (defblas sbstobf16 void
150
             (n int :copy)
151
             (x (* float))
152
             (incx int :copy)
153
             (y (* unsigned-short))
154
             (incy int :copy))
155
 
156
   (defblas sbdtobf16 void
157
             (n int :copy)
158
             (x (* double))
159
             (incx int :copy)
160
             (y (* unsigned-short))
161
             (incy int :copy))
162
 
163
   (defblas sbf16tos void
164
             (n int :copy)
165
             (x (* unsigned-short))
166
             (incx int :copy)
167
             (y (* float))
168
             (incy int :copy))
169
 
170
   (defblas dbf16tod void
171
             (n int :copy)
172
             (x (* unsigned-short))
173
             (incx int :copy)
174
             (y (* double))
175
             (incy int :copy))
176
 
177
   (defblas cdotu void
178
             (z (* complex-float))
179
             (n int :copy)
180
             (x (* float))
181
             (incx int :copy)
182
             (y (* float))
183
             (incy int :copy))
184
 
185
   (defblas cdotc void
186
             (z (* complex-float))
187
             (n int :copy)
188
             (x (* float))
189
             (incx int :copy)
190
             (y (* float))
191
             (incy int :copy))
192
 
193
   (defblas zdotu void
194
             (z (* complex-double))
195
             (n int :copy)
196
             (x (* double))
197
             (incx int :copy)
198
             (y (* double))
199
             (incy int :copy))
200
 
201
   (defblas zdotc void
202
             (z (* complex-double))
203
             (n int :copy)
204
             (x (* double))
205
             (incx int :copy)
206
             (y (* double))
207
             (incy int :copy))
208
 
209
   (defblas xdotu void
210
             (z (* complex-xdouble))
211
             (n int :copy)
212
             (x (* xdouble))
213
             (incx int :copy)
214
             (y (* xdouble))
215
             (incy int :copy))
216
 
217
   (defblas xdotc void
218
             (z (* complex-xdouble))
219
             (n int :copy)
220
             (x (* xdouble))
221
             (incx int :copy)
222
             (y (* xdouble))
223
             (incy int :copy))
224
 
225
   ;; y = ax + y
226
   (blas5s saxpy (a float :copy))
227
   (blas5d daxpy (a double :copy))
228
   (blas5q qaxpy (a xdouble :copy))
229
   (blas5c caxpy (a complex-float :copy))
230
   (blas5z zaxpy (a complex-double :copy))
231
   (blas5x xaxpy (a complex-xdouble :copy))
232
   (blas5s caxpyc (a float :copy))
233
   (blas5d zaxpyc (a double :copy))
234
   (blas5q xaxpyc (a xdouble :copy))
235
   (blas5s scopy)
236
   (blas5d dcopy)
237
   (blas5q qcopy)
238
   (blas5c ccopy)
239
   (blas5z zcopy)
240
   (blas5x xcopy)
241
   (blas5s sswap)
242
   (blas5d dswap)
243
   (blas5q qswap)
244
   (blas5c cswap)
245
   (blas5z zswap)
246
   (blas5x xswap)
247
   (blas3s sasum float)
248
   (blas3s scasum float)
249
   (blas3d dasum double)
250
   (blas3q qasum xdouble)
251
   (blas3d dzasum double)
252
   (blas3q qxasum xdouble)
253
   (blas3s ssum float)
254
   (blas3s scsum float)
255
   (blas3d dsum double)
256
   (blas3q qsum xdouble)
257
   (blas3d dzsum double)
258
   (blas3q qxsum xdouble)
259
   (blas3s isamax int)
260
   (blas3d idamax int)
261
   (blas3q iqamax int)
262
   (blas3s icamax int)
263
   (blas3d izamax int)
264
   (blas3q ixamax int)
265
   (blas3s ismax int)
266
   (blas3d idmax int)
267
   (blas3q iqmax int)
268
   (blas3s icmax int)
269
   (blas3d izmax int)
270
   (blas3q ixmax int)
271
   (blas3s isamin int)
272
   (blas3d idamin int)
273
   (blas3q iqamin int)
274
   (blas3s icamin int)
275
   (blas3d izamin int)
276
   (blas3q ixamin int)
277
   (blas3s ismin int)
278
   (blas3d idmin int)
279
   (blas3q iqmin int)
280
   (blas3s icmin int)
281
   (blas3d izmin int)
282
   (blas3q ixmin int)
283
   (blas3s samax float)
284
   (blas3d damax double)
285
   (blas3q qamax xdouble)
286
   (blas3s scamax float)
287
   (blas3d dzamax double)
288
   (blas3q qxamax xdouble)
289
   (blas3s samin float)
290
   (blas3d damin double)
291
   (blas3q qamin xdouble)
292
   (blas3s scamin float)
293
   (blas3d dzamin double)
294
   (blas3q qxamin xdouble)
295
   (blas3s smax float)
296
   (blas3d dmax double)
297
   (blas3q qmax xdouble)
298
   (blas3s scmax float)
299
   (blas3d dzmax double)
300
   (blas3q qxmax xdouble)
301
   (blas3s smin float)
302
   (blas3d dmin double)
303
   (blas3q qmin xdouble)
304
   (blas3s scmin float)
305
   (blas3d dzmin double)
306
   (blas3q qxmin xdouble)
307
   (blas4 sscal float)
308
   (blas4 dscal double)
309
   (blas4 qscal xdouble)
310
   (blas4 cscal float)
311
   (blas4 zscal double)
312
   (blas4 xscal xdouble)
313
   (blas4 csscal float)
314
   (blas4 zdscal double)
315
   (blas4 xqscal xdouble)
316
   (blas3s snrm2 float)
317
   (blas3s scnrm2 float)
318
   (blas3d dnrm2 double)
319
   (blas3q qnrm2 xdouble)
320
   (blas3d dznrm2 double)
321
   (blas3q qxnrm2 xdouble)
322
   (blas7 srot float) 
323
   (blas7 drot double)
324
   (blas7 qrot xdouble)
325
   (blas7 csrot float)
326
   (blas7 zdrot double)
327
   (blas7 xqrot xdouble)
328
   (blas4* srotg float)
329
   (blas4* drotg double)
330
   (blas4* qrotg xdouble)
331
   (blas4* crotg float)
332
   (blas4* zrotg double)
333
   (blas4* xrotg xdouble)
334
   (blas5* srotmg float)
335
   (blas5* drotmg double)
336
   (blas6 srotm float)
337
   (blas6 drotm double)
338
   (blas6 qrotm xdouble))
339
 
340
 ;;; Level 2
341
 (macrolet ((blas9 (sym type)
342
              `(defblas ,sym void 
343
                         (m int :copy) 
344
                         (n int :copy) 
345
                         (alpha ,type :copy)
346
                         (x (* ,type)) (incx int :copy) 
347
                         (y (* ,type)) (incy int :copy) 
348
                         (a (* ,type)) (lda int :copy)))
349
            (blas11 (sym type)
350
              `(defblas ,sym void
351
                         (trans char :copy)
352
                         (m int :copy)
353
                         (n int :copy)
354
                         (alpha ,type :copy)
355
                         (a (* ,type)) (lda int :copy)
356
                         (x (* ,type)) (incx int :copy) 
357
                         (beta float :copy)
358
                         (y (* ,type)) (incy int :copy)))
359
            (blas8 (sym type)
360
              `(defblas ,sym void
361
                         (uplo char :copy)
362
                         (trans char :copy)
363
                         (diag char :copy)
364
                         (n int :copy)
365
                         (a (* ,type)) (lda int :copy)
366
                         (x (* ,type)) (incx int :copy)))
367
            (blas7 (sym type)
368
              `(defblas ,sym void
369
                         (uplo char :copy)
370
                         (trans char :copy)
371
                         (diag char :copy)
372
                         (n int :copy)
373
                         (ap (* ,type))
374
                         (x (* ,type)) (incx int :copy)))
375
            (blas9* (sym type)
376
              `(defblas ,sym void
377
                         (uplo char :copy)
378
                         (trans char :copy)
379
                         (diag char :copy)
380
                         (n int :copy)
381
                         (k int :copy)
382
                         (a (* ,type)) (lda int :copy)
383
                         (x (* ,type)) (incx int :copy)))
384
            (blas10 (sym type)
385
              `(defblas ,sym void
386
                         (uplo char :copy)
387
                         (n int :copy)
388
                         (alpha ,type :copy)
389
                         (a (* ,type)) (lda int :copy)
390
                         (x (* ,type)) (incx int :copy) 
391
                         (beta ,type :copy)
392
                         (y (* ,type)) (incy int :copy)))
393
            (blas9** (sym type)
394
              `(defblas ,sym void
395
                         (uplo char :copy)
396
                         (n int :copy)
397
                         (alpha ,type :copy)
398
                         (a (* ,type))
399
                         (x (* ,type)) (incx int :copy)
400
                         (beta float :copy)
401
                         (y (* ,type)) (incy int :copy)))
402
            (blas7* (sym type)
403
              `(defblas ,sym void
404
                         (uplo char :copy)
405
                         (n int :copy)
406
                         (x (* ,type)) (incx int :copy)
407
                         (a (* ,type)) (lda int :copy)))
408
            (blas9*** (sym type)
409
              `(defblas ,sym void
410
                         (uplo char :copy)
411
                         (n int :copy)
412
                         (alpha ,type :copy)
413
                         (x (* ,type)) (incx int :copy)
414
                         (y (* ,type)) (incy int :copy)
415
                         (a (* ,type)) (lda int :copy)))
416
            (blas6* (sym type)
417
              `(defblas ,sym void
418
                         (uplo char :copy)
419
                         (n int :copy)
420
                         (alpha ,type :copy)
421
                         (x (* ,type)) (incx int :copy)
422
                         (a (* ,type))))
423
            (blas8* (sym type)
424
              `(defblas ,sym void
425
                         (uplo char :copy)
426
                         (n int :copy)
427
                         (alpha ,type :copy)
428
                         (x (* ,type)) (incx int :copy)
429
                         (y (* ,type)) (incy int :copy)
430
                         (a (* ,type))))
431
            (blas7** (sym type)
432
              `(defblas ,sym void
433
                         (uplo char :copy)
434
                         (n int :copy)
435
                         (alpha ,type :copy)
436
                         (x (* ,type)) (incx int :copy)
437
                         (a (* ,type)) (lda int :copy)))
438
            (blas13 (sym type)
439
              `(defblas ,sym void
440
                         (trans char :copy)
441
                         (m int :copy)
442
                         (n int :copy)
443
                         (kl int :copy)
444
                         (ku int :copy)
445
                         (alpha ,type :copy)
446
                         (a (* ,type)) (lda int :copy)
447
                         (x (* ,type)) (incx int :copy) 
448
                         (beta ,type :copy)
449
                         (y (* ,type)) (incy int :copy))))
450
   (blas9 sger float) 
451
   (blas9 dger double)
452
   (blas9 qger xdouble)
453
   (blas9 cgeru float)
454
   (blas9 cgerc float)
455
   (blas9 zgeru double)
456
   (blas9 zgerc double)
457
   (blas9 xgeru xdouble)
458
   (blas9 xgerc xdouble)
459
   (defblas sbgemv void
460
             (trans char :copy)
461
             (m int :copy)
462
             (n int :copy)
463
             (alpha float :copy)
464
             (a (* unsigned-short)) (lda int :copy)
465
             (x (* unsigned-short)) (incx int :copy)
466
             (beta float :copy)
467
             (y (* float)) (incy int :copy))
468
   (blas11 sgemv float)
469
   (blas11 dgemv double)
470
   (blas11 qgemv xdouble)
471
   (blas11 cgemv float)
472
   (blas11 zgemv double)
473
   (blas11 xgemv xdouble)
474
   (blas8 strsv float)
475
   (blas8 dtrsv double)
476
   (blas8 qtrsv xdouble)
477
   (blas8 ctrsv float)
478
   (blas8 ztrsv double)
479
   (blas8 xtrsv xdouble)
480
   (blas8 strmv float)
481
   (blas8 dtrmv double)
482
   (blas8 qtrmv xdouble)
483
   (blas8 ctrmv float)
484
   (blas8 ztrmv double)
485
   (blas8 xtrmv xdouble)
486
   (blas7 stpsv float)
487
   (blas7 dtpsv double)
488
   (blas7 qtpsv xdouble)
489
   (blas7 ctpsv float)
490
   (blas7 ztpsv double)
491
   (blas7 xtpsv xdouble)
492
   (blas7 stpmv float)
493
   (blas7 dtpmv double)
494
   (blas7 qtpmv xdouble)
495
   (blas7 ctpmv float)
496
   (blas7 ztpmv double)
497
   (blas7 xtpmv xdouble)
498
   (blas9* stbmv float)
499
   (blas9* dtbmv double)
500
   (blas9* qtbmv xdouble)
501
   (blas9* ctbmv float)
502
   (blas9* ztbmv double)
503
   (blas9* xtbmv xdouble)
504
   (blas9* stbsv float)
505
   (blas9* dtbsv double)
506
   (blas9* qtbsv xdouble)
507
   (blas9* ctbsv float)
508
   (blas9* ztbsv double)
509
   (blas9* xtbsv xdouble)
510
   (blas10 ssymv float)
511
   (blas10 dsymv double)
512
   (blas10 qsymv xdouble)
513
   (blas10 csymv float)
514
   (blas10 zsymv double)
515
   (blas10 xsymv xdouble)
516
   (blas9** sspmv float)
517
   (blas9** dspmv double)
518
   (blas9** qspmv xdouble)
519
   (blas9** cspmv float)
520
   (blas9** zspmv double)
521
   (blas9** xspmv xdouble)
522
   (blas7* ssyr float)
523
   (blas7* dsyr double)
524
   (blas7* qsyr xdouble)
525
   (blas7* csyr float)
526
   (blas7* zsyr double)
527
   (blas7* xsyr xdouble)
528
   (blas9*** ssyr2 float)
529
   (blas9*** dsyr2 double)
530
   (blas9*** qsyr2 xdouble)
531
   (blas9*** csyr2 float)
532
   (blas9*** zsyr2 double)
533
   (blas9*** xsyr2 xdouble)
534
   (blas6* sspr float)
535
   (blas6* dspr double)
536
   (blas6* qspr xdouble)
537
   (blas6* cspr float)
538
   (blas6* zspr double)
539
   (blas6* xspr xdouble)
540
   (blas8* sspr2 float)
541
   (blas8* dspr2 double)
542
   (blas8* qspr2 xdouble)
543
   (blas8* cspr2 float)
544
   (blas8* zspr2 double)
545
   (blas8* xspr2 xdouble)
546
   (blas7** cher float)
547
   (blas7** zher double)
548
   (blas7** xher xdouble)
549
   (blas6* chpr float)
550
   (blas6* zhpr double)
551
   (blas6* xhpr xdouble)
552
   (blas9*** cher2 float)
553
   (blas9*** zher2 double)
554
   (blas9*** xher2 xdouble)
555
   (blas8* chpr2 float)
556
   (blas8* zhpr2 double)
557
   (blas8* xhpr2 xdouble)
558
   (blas10 chemv float)
559
   (blas10 zhemv double)
560
   (blas10 xhemv xdouble)
561
   (blas9** chpmv float)
562
   (blas9** zhpmv double)
563
   (blas9** xhpmv xdouble)
564
   ;; *norm not part of spec
565
   (defblas snorm int (uplo char :copy) (n int :copy) (alpha int :copy) (x (* float)) (incx int :copy))
566
   (defblas dnorm int (uplo char :copy) (n int :copy) (alpha int :copy) (x (* double)) (incx int :copy))
567
   (defblas cnorm int (uplo char :copy) (n int :copy) (alpha int :copy) (x (* float)) (incx int :copy))
568
   (defblas znorm int (uplo char :copy) (n int :copy) (alpha int :copy) (x (* double)) (incx int :copy))
569
   (blas13 sgbmv float)
570
   (blas13 dgbmv double)
571
   (blas13 qgbmv xdouble)
572
   (blas13 cgbmv float)
573
   (blas13 zgbmv double)
574
   (blas13 xgbmv xdouble)
575
   (blas11 ssbmv float)
576
   (blas11 dsbmv double)
577
   (blas11 qsbmv xdouble)
578
   (blas11 csbmv float)
579
   (blas11 zsbmv double)
580
   (blas11 xsbmv xdouble)
581
   (blas11 chbmv float)
582
   (blas11 zhbmv double)
583
   (blas11 xhbmv xdouble))
584
 
585
 ;;; Level 3
586
 (macrolet ((blas13 (sym type)
587
              `(defblas ,sym void
588
                         (transa char :copy)
589
                         (transb char :copy)
590
                         (m int :copy)
591
                         (n int :copy)
592
                         (k int :copy)
593
                         (alpha ,type :copy)
594
                         (a (* ,type))
595
                         (lda int :copy)
596
                         (b (* ,type))
597
                         (ldb int :copy)
598
                         (beta ,type :copy)
599
                         (c (* ,type))
600
                         (ldc int :copy)))
601
            (blas13* (sym type)
602
              `(defblas ,sym void
603
                         (uplo char :copy)
604
                         (transa char :copy)
605
                         (transb char :copy)
606
                         (n int :copy)
607
                         (k int :copy)
608
                         (alpha ,type :copy)
609
                         (a (* ,type))
610
                         (lda int :copy)
611
                         (b (* ,type))
612
                         (ldb int :copy)
613
                         (beta ,type :copy)
614
                         (c (* ,type))
615
                         (ldc int :copy)))
616
            (blas11 (sym type)
617
              `(defblas ,sym void
618
                         (side char :copy)
619
                         (uplo char :copy)
620
                         (transa char :copy)
621
                         (diag char :copy)
622
                         (m int :copy)
623
                         (n int :copy)
624
                         (alpha ,type :copy)
625
                         (a (* ,type))
626
                         (lda int :copy)
627
                         (b (* ,type))
628
                         (ldb int :copy)))
629
            (blas12 (sym type)
630
              `(defblas ,sym void
631
                         (side char :copy)
632
                         (uplo char :copy)
633
                         (m int :copy)
634
                         (n int :copy)
635
                         (alpha ,type :copy)
636
                         (a (* ,type))
637
                         (lda int :copy)
638
                         (b (* ,type))
639
                         (ldb int :copy)
640
                         (beta ,type :copy)
641
                         (c (* ,type))
642
                         (ldc int :copy)))
643
            (blas10 (sym type)
644
              `(defblas ,sym void
645
                         (uplo char :copy)
646
                         (trans char :copy)
647
                         (n int :copy)
648
                         (k int :copy)
649
                         (alpha ,type :copy)
650
                         (a (* ,type))
651
                         (lda int :copy)
652
                         (beta ,type :copy)
653
                         (c (* ,type))
654
                         (ldc int :copy)))
655
            (blas12* (sym type)
656
              `(defblas ,sym void
657
                         (uplo char :copy)
658
                         (trans char :copy)
659
                         (n int :copy)
660
                         (k int :copy)
661
                         (alpha ,type :copy)
662
                         (a (* ,type))
663
                         (lda int :copy)
664
                         (b (* ,type))
665
                         (ldb int :copy)
666
                         (beta ,type :copy)
667
                         (c (* ,type))
668
                         (ldc int :copy)))
669
            (blas12% (sym type)
670
              `(defblas ,sym int
671
                         (uplo char :copy)
672
                         (trans char :copy)
673
                         (n int :copy)
674
                         (k int :copy)
675
                         (alpha ,type :copy)
676
                         (a (* ,type))
677
                         (lda int :copy)
678
                         (b (* ,type))
679
                         (ldb int :copy)
680
                         (beta ,type :copy)
681
                         (c (* ,type))
682
                         (ldc int :copy)))
683
            (blas8 (sym type)
684
              `(defblas ,sym int
685
                         (uplo char :copy)
686
                         (n int :copy)
687
                         (k int :copy)
688
                         (alpha ,type :copy)
689
                         (a (* ,type))
690
                         (lda int :copy)
691
                         (b (* ,type))
692
                         (ldb int :copy)))
693
            (blas12** (sym type)
694
              `(defblas ,sym int
695
                         (uplo char :copy)
696
                         (trans char :copy)
697
                         (n int :copy)
698
                         (k int :copy)
699
                         (alpha ,type :copy)
700
                         (a (* ,type))
701
                         (lda int :copy)
702
                         (beta ,type :copy)
703
                         (b (* ,type))
704
                         (ldb int :copy)
705
                         (c (* ,type))
706
                         (ldc int :copy)))
707
            (blas15 (sym type)
708
              `(defblas ,sym int
709
                         (uplo char :copy)
710
                         (trans char :copy)
711
                         (m int :copy)
712
                         (n int :copy)
713
                         (k int :copy)
714
                         (alpha ,type :copy)
715
                         (a (* ,type))
716
                         (lda int :copy)
717
                         (b (* ,type))
718
                         (ldb int :copy)
719
                         (c (* ,type))
720
                         (ldc int :copy)
721
                         (beta ,type :copy)
722
                         (x (* ,type))
723
                         (incx int :copy))))
724
   (defblas sbgemm void
725
             (transa char :copy)
726
             (transb char :copy)
727
             (m int :copy)
728
             (n int :copy)
729
             (k int :copy)
730
             (alpha float :copy)
731
             (a (* unsigned-short))
732
             (lda int :copy)
733
             (b (* unsigned-short))
734
             (ldb int :copy)
735
             (beta float :copy)
736
             (c (* float))
737
             (ldc int :copy))
738
   (blas13 sgemm float)
739
   (blas13 dgemm double)
740
   (blas13 qgemm xdouble)
741
   (blas13 cgemm float)
742
   (blas13 zgemm double)
743
   (blas13 xgemm xdouble)
744
   (blas13 cgemm3m float)
745
   (blas13 zgemm3m double)
746
   (blas13 xgemm3m xdouble)
747
   (blas13* sgemmt float)
748
   (blas13* dgemmt double)
749
   (blas13* cgemmt float)
750
   (blas13* zgemmt double)
751
   (blas13* sge2mm float)
752
   (blas13* dge2mm double)
753
   (blas13* cge2mm float)
754
   (blas13* zge2mm double)
755
   (blas11 strsm float)
756
   (blas11 dtrsm double)
757
   (blas11 qtrsm xdouble)
758
   (blas11 ctrsm float)
759
   (blas11 ztrsm double)
760
   (blas11 xtrsm xdouble)
761
   (blas11 strmm float)
762
   (blas11 dtrmm double)
763
   (blas11 qtrmm xdouble)
764
   (blas11 ctrmm float)
765
   (blas11 ztrmm double)
766
   (blas11 xtrmm xdouble)
767
   (blas12 ssymm float)
768
   (blas12 dsymm double)
769
   (blas12 qsymm xdouble)
770
   (blas12 csymm float)
771
   (blas12 zsymm double)
772
   (blas12 xsymm xdouble)
773
   (blas12 csymm3m float)
774
   (blas12 zsymm3m double)
775
   (blas12 xsymm3m xdouble)
776
   (blas10 ssyrk float)
777
   (blas10 dsyrk double)
778
   (blas10 qsyrk xdouble)
779
   (blas10 csyrk float)
780
   (blas10 zsyrk double)
781
   (blas10 xsyrk xdouble)
782
   (blas12* ssyr2k float)
783
   (blas12* dsyr2k double)
784
   (blas12* qsyr2k xdouble)
785
   (blas12* csyr2k float)
786
   (blas12* zsyr2k double)
787
   (blas12* xsyr2k xdouble)
788
   (blas12* chemm float)
789
   (blas12* zhemm double)
790
   (blas12* xhemm xdouble)
791
   (blas12* chemm3m float)
792
   (blas12* zhemm3m double)
793
   (blas12* xhemm3m xdouble)
794
   (blas10 cherk float)
795
   (blas10 zherk double)
796
   (blas10 xherk xdouble)
797
   (blas12* cher2k float)
798
   (blas12* zher2k double)
799
   (blas12* xher2k xdouble)
800
   (blas12% cher2m float)
801
   (blas12% zher2m double)
802
   (blas12% xher2m xdouble)
803
   (blas8 sgemt float)
804
   (blas8 dgemt double)
805
   (blas8 cgemt float)
806
   (blas8 zgemt double)
807
   (blas12** sgema float)
808
   (blas12** dgema double)
809
   (blas12** cgema float)
810
   (blas12** zgema double)
811
   (blas12** sgems float)
812
   (blas12** dgems double)
813
   (blas12** cgems float)
814
   (blas12** zgems double)
815
   (blas15 sgemc float)
816
   (blas15 dgemc double)
817
   (blas15 qgemc xdouble)
818
   (blas15 cgemc float)
819
   (blas15 zgemc double)
820
   (blas15 xgemc xdouble))
821
 
822
 ;;; Lapack routines
823
 (macrolet ((lap6 (sym type)
824
              `(defblas ,sym int 
825
                         (m int :copy) 
826
                         (n int :copy) 
827
                         (a (* ,type)) 
828
                         (lda int :copy)
829
                         (ipiv (* int))
830
                         (info int :copy)))
831
            (lap7 (sym type)
832
              `(defblas ,sym int
833
                         (n int :copy) 
834
                         (a (* ,type)) 
835
                         (lda int :copy)
836
                         (k1 int :copy)
837
                         (k2 int :copy)
838
                         (ipiv (* int))
839
                         (incx int :copy)))
840
            (lap9 (sym type)
841
              `(defblas ,sym int
842
                         (trans char :copy)
843
                         (n int :copy)
844
                         (nrhs int :copy)
845
                         (a (* ,type))
846
                         (lda int :copy)
847
                         (ipiv (* int))
848
                         (b (* ,type))
849
                         (ldb int :copy)
850
                         (info int :copy)))
851
            (lap8 (sym type)
852
              `(defblas ,sym int
853
                         (n int :copy)
854
                         (nrhs int :copy)
855
                         (a (* ,type))
856
                         (lda int :copy)
857
                         (ipiv (* int))
858
                         (b (* ,type))
859
                         (ldb int :copy)
860
                         (info int :copy)))
861
            (lap5 (sym type)
862
              `(defblas ,sym int
863
                         (uplo char :copy)
864
                         (n int :copy)
865
                         (a (* ,type))
866
                         (lda int :copy)
867
                         (info int :copy)))
868
            (lap8* (sym type)
869
              `(defblas ,sym int
870
                         (uplo char :copy)
871
                         (n int :copy)
872
                         (nrhs int :copy)
873
                         (a (* ,type))
874
                         (lda int :copy)
875
                         (b (* ,type))
876
                         (ldb int :copy)
877
                         (info int :copy)))
878
            (lap6* (sym type)
879
              `(defblas ,sym int
880
                         (uplo char :copy)
881
                         (diag char :copy)
882
                         (n int :copy)
883
                         (a (* ,type))
884
                         (lda int :copy)
885
                         (info int :copy))))
886
   (lap6 sgetf2 float)
887
   (lap6 dgetf2 double)
888
   (lap6 qgetf2 xdouble)
889
   (lap6 cgetf2 float)
890
   (lap6 zgetf2 double)
891
   (lap6 xgetf2 xdouble)
892
   (lap6 sgetrf float)
893
   (lap6 dgetrf double)
894
   (lap6 qgetrf xdouble)
895
   (lap6 cgetrf float)
896
   (lap6 zgetrf double)
897
   (lap6 xgetrf xdouble)
898
   (lap7 slaswp float)
899
   (lap7 dlaswp double)
900
   (lap7 qlaswp xdouble)
901
   (lap7 claswp float)
902
   (lap7 zlaswp double)
903
   (lap7 xlaswp xdouble)
904
   (lap9 sgetrs float)
905
   (lap9 dgetrs double)
906
   (lap9 qgetrs xdouble)
907
   (lap9 cgetrs float)
908
   (lap9 zgetrs double)
909
   (lap9 xgetrs xdouble)
910
   (lap8 sgesv float)
911
   (lap8 dgesv double)
912
   (lap8 qgesv xdouble)
913
   (lap8 cgesv float)
914
   (lap8 zgesv double)
915
   (lap8 xgesv xdouble)
916
   (lap5 spotf2 float)
917
   (lap5 dpotf2 double)
918
   (lap5 qpotf2 xdouble)
919
   (lap5 cpotf2 float)
920
   (lap5 zpotf2 double)
921
   (lap5 xpotf2 xdouble)
922
   (lap5 spotrf float)
923
   (lap5 dpotrf double)
924
   (lap5 qpotrf xdouble)
925
   (lap5 cpotrf float)
926
   (lap5 zpotrf double)
927
   (lap5 xpotrf xdouble)
928
   (lap5 spotri float)
929
   (lap5 dpotri double)
930
   (lap5 qpotri xdouble)
931
   (lap5 cpotri float)
932
   (lap5 zpotri double)
933
   (lap5 xpotri xdouble)
934
   (lap8* spotrs float)
935
   (lap8* dpotrs double)
936
   (lap8* qpotrs xdouble)
937
   (lap8* cpotrs float)
938
   (lap8* zpotrs double)
939
   (lap8* xpotrs xdouble)
940
   (lap5 slauu2 float)
941
   (lap5 dlauu2 double)
942
   (lap5 qlauu2 xdouble)
943
   (lap5 clauu2 float)
944
   (lap5 zlauu2 double)
945
   (lap5 xlauu2 xdouble)
946
   (lap5 slauum float)
947
   (lap5 dlauum double)
948
   (lap5 qlauum xdouble)
949
   (lap5 clauum float)
950
   (lap5 zlauum double)
951
   (lap5 xlauum xdouble)
952
   (lap6* strti2 float)
953
   (lap6* dtrti2 double)
954
   (lap6* qtrti2 xdouble)
955
   (lap6* ctrti2 float)
956
   (lap6* ztrti2 double)
957
   (lap6* xrti2 xdouble)
958
   (lap6* strti float)
959
   (lap6* dtrti double)
960
   (lap6* qtrti xdouble)
961
   (lap6* ctrti float)
962
   (lap6* ztrti double)
963
   (lap6* xtrti xdouble)
964
   (defblas slamch float (cmach char :copy))
965
   (defblas dlamch double (cmach char :copy))
966
   (defblas qlamch xdouble (cmach char :copy))
967
   (defblas slamc3 float (a float :copy) (b float :copy))
968
   (defblas dlamc3 double (a double :copy) (b double :copy))
969
   (defblas qlamc3 xdouble (a xdouble :copy) (b xdouble :copy)))
970
 
971
 ;;; BLAS extensions
972
 ;; ref: https://www.intel.com/content/www/us/en/docs/onemkl/developer-reference-fortran/2025-1/overview.html
973
 ;; saxpby daxpby caxpby zaxpby
974
 ;; somatcopy domatcopy comatcopy zomatcopy
975
 ;; simatcopy dimatcopy cimatcopy zimatcopy
976
 ;; sgeadd dgeadd cgeadd zgeadd