steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix complex blas vectors

db4
Joe Groff 2008-12-04 14:03:13 -08:00
parent ef0bc65039
commit bd59b86ad6
1 changed files with 20 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
extra/math/blas/vectors/vectors.factor
View File

@ -128,8 +128,6 @@ FUNCTOR: (define-blas-vector) ( TYPE T -- )
>ARRAY IS >${TYPE}-array >ARRAY IS >${TYPE}-array
XCOPY IS cblas_${T}copy XCOPY IS cblas_${T}copy
XSWAP IS cblas_${T}swap XSWAP IS cblas_${T}swap
XAXPY IS cblas_${T}axpy
XSCAL IS cblas_${T}scal
IXAMAX IS cblas_i${T}amax IXAMAX IS cblas_i${T}amax
VECTOR DEFINES ${TYPE}-blas-vector VECTOR DEFINES ${TYPE}-blas-vector
@ -150,10 +148,6 @@ M: VECTOR clone
M: VECTOR element-type M: VECTOR element-type
drop TYPE ; drop TYPE ;
M: VECTOR n*V+V!
(prepare-axpy) [ XAXPY execute ] dip ;
M: VECTOR n*V!
(prepare-scal) [ XSCAL execute ] dip ;
M: VECTOR Vswap M: VECTOR Vswap
(prepare-swap) [ XSWAP execute ] 2dip ; (prepare-swap) [ XSWAP execute ] 2dip ;
M: VECTOR Viamax M: VECTOR Viamax
@ -176,6 +170,8 @@ VECTOR IS ${TYPE}-blas-vector
XDOT IS cblas_${T}dot XDOT IS cblas_${T}dot
XNRM2 IS cblas_${T}nrm2 XNRM2 IS cblas_${T}nrm2
XASUM IS cblas_${T}asum XASUM IS cblas_${T}asum
XAXPY IS cblas_${T}axpy
XSCAL IS cblas_${T}scal
WHERE WHERE
@ -187,6 +183,10 @@ M: VECTOR Vnorm
(prepare-nrm2) XNRM2 execute ; (prepare-nrm2) XNRM2 execute ;
M: VECTOR Vasum M: VECTOR Vasum
(prepare-nrm2) XASUM execute ; (prepare-nrm2) XASUM execute ;
M: VECTOR n*V+V!
(prepare-axpy) [ XAXPY execute ] dip ;
M: VECTOR n*V!
(prepare-scal) [ XSCAL execute ] dip ;
;FUNCTOR ;FUNCTOR
@ -196,15 +196,18 @@ FUNCTOR: (define-complex-helpers) ( TYPE -- )
<DIRECT-COMPLEX-ARRAY> DEFINES <direct-${TYPE}-complex-array> <DIRECT-COMPLEX-ARRAY> DEFINES <direct-${TYPE}-complex-array>
>COMPLEX-ARRAY DEFINES >${TYPE}-complex-array >COMPLEX-ARRAY DEFINES >${TYPE}-complex-array
ALIEN>COMPLEX DEFINES alien>${TYPE}-complex ALIEN>COMPLEX DEFINES alien>${TYPE}-complex
COMPLEX>ALIEN DEFINES ${TYPE}-complex>alien
<DIRECT-ARRAY> IS <direct-${TYPE}-array> <DIRECT-ARRAY> IS <direct-${TYPE}-array>
>ARRAY IS >${TYPE}-array >ARRAY IS >${TYPE}-array
WHERE WHERE
: <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence ) : <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
<DIRECT-ARRAY> execute <complex-sequence> ; 1 shift <DIRECT-ARRAY> execute <complex-sequence> ;
: >COMPLEX-ARRAY ( sequence -- sequence ) : >COMPLEX-ARRAY ( sequence -- sequence )
<complex-components> >ARRAY execute ; <complex-components> >ARRAY execute ;
: COMPLEX>ALIEN ( complex -- alien )
>rect 2array >ARRAY execute underlying>> ;
: ALIEN>COMPLEX ( alien -- complex ) : ALIEN>COMPLEX ( alien -- complex )
2 <DIRECT-ARRAY> execute first2 rect> ; 2 <DIRECT-ARRAY> execute first2 rect> ;
@ -218,6 +221,9 @@ XDOTU_SUB IS cblas_${C}dotu_sub
XDOTC_SUB IS cblas_${C}dotc_sub XDOTC_SUB IS cblas_${C}dotc_sub
XXNRM2 IS cblas_${S}${C}nrm2 XXNRM2 IS cblas_${S}${C}nrm2
XXASUM IS cblas_${S}${C}asum XXASUM IS cblas_${S}${C}asum
XAXPY IS cblas_${C}axpy
XSCAL IS cblas_${C}scal
TYPE>ALIEN IS ${TYPE}>alien
ALIEN>TYPE IS alien>${TYPE} ALIEN>TYPE IS alien>${TYPE}
WHERE WHERE
@ -234,6 +240,12 @@ M: VECTOR Vnorm
(prepare-nrm2) XXNRM2 execute ; (prepare-nrm2) XXNRM2 execute ;
M: VECTOR Vasum M: VECTOR Vasum
(prepare-nrm2) XXASUM execute ; (prepare-nrm2) XXASUM execute ;
M: VECTOR n*V+V!
[ TYPE>ALIEN execute ] 2dip
(prepare-axpy) [ XAXPY execute ] dip ;
M: VECTOR n*V!
[ TYPE>ALIEN execute ] dip
(prepare-scal) [ XSCAL execute ] dip ;
;FUNCTOR ;FUNCTOR
@ -245,8 +257,7 @@ M: VECTOR Vasum
TYPE (define-complex-helpers) TYPE (define-complex-helpers)
TYPE "-complex" append TYPE "-complex" append
[ C (define-blas-vector) ] [ C (define-blas-vector) ]
[ C S (define-complex-blas-vector) ] bi [ C S (define-complex-blas-vector) ] bi ;
;
"float" "s" define-real-blas-vector "float" "s" define-real-blas-vector
"double" "d" define-real-blas-vector "double" "d" define-real-blas-vector