[lisplab-cvs] r88 - src/core src/fft
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Thu Aug 27 13:17:04 UTC 2009
Author: jivestgarden
Date: Thu Aug 27 09:17:04 2009
New Revision: 88
Log:
paralell fftw
Modified:
Makefile
lisplab.asd
package.lisp
src/core/level0-basic.lisp
src/core/level0-interface.lisp
src/fft/fftw-ffi-package.lisp
src/fft/fftw-ffi.lisp
src/fft/level3-fft-fftw.lisp
Modified: Makefile
==============================================================================
--- Makefile (original)
+++ Makefile Thu Aug 27 09:17:04 2009
@@ -11,9 +11,9 @@
touch system/lisplab.asd
lispclean:
- -find . -name "*.fasl" -execdir rm \{} \;
+ -find . -name "*.fasl" -exec rm \{} \;
clean: lispclean
distclean: clean
- -find . -name "*~" -execdir rm \{} \;
\ No newline at end of file
+ -find . -name "*~" -exec rm \{} \;
\ No newline at end of file
Modified: lisplab.asd
==============================================================================
--- lisplab.asd (original)
+++ lisplab.asd Thu Aug 27 09:17:04 2009
@@ -17,6 +17,9 @@
(defun explain-lisplab-lib (name path)
(format t "Loads ~A. Path ~a" name path))
+(declaim (inline |fftw_init_threads|))
+(sb-alien:define-alien-routine |fftw_init_threads|
+ sb-alien:int)
(defsystem :lisplab
;; Default system, without all libs
@@ -173,7 +176,9 @@
(load-lisplab-lib
cl-user::*lisplab-libfftw-path*)
(load-lisplab-lib
- cl-user::*lisplab-libfftw-threads-path*))
+ cl-user::*lisplab-libfftw-threads-path*)
+ (when cl-user::*lisplab-libfftw-threads-path*
+ (assert (/= 0 (|fftw_init_threads|)))))
:explain (asdf:load-op :after (op c)
(explain-lisplab-lib
"FFTW"
Modified: package.lisp
==============================================================================
--- package.lisp (original)
+++ package.lisp Thu Aug 27 09:17:04 2009
@@ -49,6 +49,8 @@
;; Utilities
"IN-DIR"
"STRCAT"
+ "INIT-THREADS"
+ "CLEANUP-THREADS"
;; Numerical constants
"%I"
Modified: src/core/level0-basic.lisp
==============================================================================
--- src/core/level0-basic.lisp (original)
+++ src/core/level0-basic.lisp Thu Aug 27 09:17:04 2009
@@ -73,4 +73,16 @@
(defun dvec (n)
"Creates a double vector with n elements."
- (make-array n :element-type 'double-float :initial-element 0.0))
\ No newline at end of file
+ (make-array n :element-type 'double-float :initial-element 0.0))
+
+
+;;; THREADS stuff. TODO: move away from here
+
+(defvar *lisplab-num-threads* 0)
+
+(defmethod init-threads (num-threads)
+ (cleanup-threads)
+ (setf *lisplab-num-threads* num-threads))
+
+(defmethod cleanup-threads ())
+
Modified: src/core/level0-interface.lisp
==============================================================================
--- src/core/level0-interface.lisp (original)
+++ src/core/level0-interface.lisp Thu Aug 27 09:17:04 2009
@@ -55,7 +55,11 @@
(.exp . exp) (.sqrt . sqrt) (.conj . conjugate))
"Functions with a twin in the Common Lisp package.")
+(defgeneric init-threads (num-threads)
+ (:documentation "Request to use a certain number of threads for calculations."))
+(defgeneric cleanup-threads ()
+ (:documentation "Kills unused threads and frees resources."))
(defgeneric scalar? (x)
(:documentation "A scalar is a object with ignored internal structure."))
Modified: src/fft/fftw-ffi-package.lisp
==============================================================================
--- src/fft/fftw-ffi-package.lisp (original)
+++ src/fft/fftw-ffi-package.lisp Thu Aug 27 09:17:04 2009
@@ -21,5 +21,7 @@
"+FFTW-FORWARD+"
"+FFTW-BACKWARD+"
"FFTW-FFT1"
- "FFTW-FFT2")
+ "FFTW-FFT2"
+ "FFTW-INIT-THREADS"
+ "FFTW-CLEANUP-THREADS")
(:documentation "Simple ffi for fftw."))
Modified: src/fft/fftw-ffi.lisp
==============================================================================
--- src/fft/fftw-ffi.lisp (original)
+++ src/fft/fftw-ffi.lisp Thu Aug 27 09:17:04 2009
@@ -77,7 +77,7 @@
(defun fftw-fft2 (m n in out direction flag)
"Two dimensional fft by forign call to fftw."
;; TODO we should handle conditions to avoid mem-leaks
- (with-pinned-objects (in out)
+ (with-pinned-objects (in out m n direction flag)
(let ((plan (|fftw_plan_dft_2d|
n ; swap n and m due to row major order
m
@@ -105,4 +105,10 @@
(define-alien-routine |fftw_cleanup_threads|
void)
+(defun fftw-init-threads (num-threads)
+ ;; Note: assumes that |fftw_init_threads| has been called!
+ (|fftw_plan_with_nthreads| num-threads))
+
+(defun fftw-cleanup-threads ()
+ (|fftw_cleanup_threads|))
Modified: src/fft/level3-fft-fftw.lisp
==============================================================================
--- src/fft/level3-fft-fftw.lisp (original)
+++ src/fft/level3-fft-fftw.lisp Thu Aug 27 09:17:04 2009
@@ -22,6 +22,101 @@
(in-package :lisplab)
+(defmethod fft1 ((x matrix-blas-dge) &key)
+ (fft1 (convert-to-matrix-zge x)))
+
+(defmethod ifft1 ((x matrix-blas-dge) &key)
+ (ifft1 (convert-to-matrix-zge x)))
+
+(defmethod fft2 ((x matrix-blas-dge) &key)
+ (fft2 (convert-to-matrix-zge x)))
+
+(defmethod ifft2 ((x matrix-blas-dge) &key)
+ (ifft2 (convert-to-matrix-zge x)))
+
+(defun use-fftw-p ()
+ cl-user::*lisplab-libfftw-path*)
+
+(defun fftw-use-threads-p ()
+ (and cl-user::*lisplab-libfftw-threads-path*
+ (> *lisplab-num-threads* 0)))
+
+(defmethod init-threads :after (num-threads)
+ (when (fftw-use-threads-p)
+ (fftw-ffi:fftw-init-threads num-threads)))
+
+(defmethod cleanup-threads :after ()
+ (when (fftw-use-threads-p)
+ (fftw-ffi:fftw-cleanup-threads)))
+
+(defmethod fft1 ((x matrix-blas-zge) &key)
+ (if (not (use-fftw-p))
+ (call-next-method)
+ (let* ((rows (rows x))
+ (cols (cols x))
+ (store-x (matrix-store x))
+ (y (mcreate x))
+ (store-y (matrix-store y)))
+ (dotimes (i cols)
+ ;; Could be made in parallel
+ (fftw-ffi:fftw-fft1
+ rows
+ store-x
+ (* i cols)
+ store-y
+ (* i cols)
+ fftw-ffi:+FFTW-FORWARD+
+ fftw-ffi:+FFTW-ESTIMATE+))
+ y)))
+
+(defmethod ifft1 ((x matrix-blas-zge) &key)
+ (if (not (use-fftw-p))
+ (call-next-method)
+ (let* ((rows (rows x))
+ (cols (cols x))
+ (store-x (matrix-store x))
+ (y (mcreate x))
+ (store-y (matrix-store y)))
+ (dotimes (i cols)
+ ;; Could be made in parallel
+ (fftw-ffi:fftw-fft1
+ rows
+ store-x
+ (* i cols)
+ store-y
+ (* i cols)
+ fftw-ffi:+FFTW-BACKWARD+
+ fftw-ffi:+FFTW-ESTIMATE+))
+ y)))
+
+(defmethod fft2 ((x matrix-blas-zge) &key)
+ (if (not (use-fftw-p))
+ (call-next-method)
+ (let ((y (mcreate x)))
+ (fftw-ffi:fftw-fft2
+ (rows x)
+ (cols x)
+ (matrix-store x)
+ (matrix-store y)
+ fftw-ffi:+fftw-forward+
+ fftw-ffi:+FFTW-ESTIMATE+)
+ y)))
+
+(defmethod ifft2 ((x matrix-blas-zge) &key)
+ (if (not (use-fftw-p))
+ (call-next-method)
+ (let ((y (mcreate x)))
+ (fftw-ffi:fftw-fft2
+ (rows x)
+ (cols x)
+ (matrix-store x)
+ (matrix-store y)
+ fftw-ffi:+fftw-backward+
+ fftw-ffi:+FFTW-ESTIMATE+)
+ y)))
+
+;;; TODO: remove the destructive mothods below. They only mess things up
+
(defun fft1!-forward-or-backward (x direction)
(let* ((rows (rows x))
(cols (cols x))
More information about the lisplab-cvs
mailing list