[lisplab-cvs] r87 - src/fft
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Tue Aug 25 19:34:30 UTC 2009
Author: jivestgarden
Date: Tue Aug 25 15:34:30 2009
New Revision: 87
Log:
prepeared for threads in fftw
Modified:
lisplab.asd
src/fft/fftw-ffi.lisp
src/fft/level3-fft-fftw.lisp
src/fft/level3-fft-generic.lisp
src/fft/level3-fft-interface.lisp
src/fft/level3-fft-zge.lisp
Modified: lisplab.asd
==============================================================================
--- lisplab.asd (original)
+++ lisplab.asd Tue Aug 25 15:34:30 2009
@@ -4,7 +4,8 @@
(defvar *lisplab-libblas-path* nil "Path to BLAS shared object file.")
(defvar *lisplab-liblapack-path* nil "Path to LAPACK shared object file.")
-(defvar *lisplab-libfftw-path* nil "Path to FFTW shared object file.")
+(defvar *lisplab-libfftw-path* nil "Path to FFTW 3 shared object file.")
+(defvar *lisplab-libfftw-threads-path* nil "Path to FFTW 3 thread extension shared object file.")
(defpackage :asdf-lisplab (:use :asdf :cl))
(in-package :asdf-lisplab)
@@ -170,11 +171,16 @@
(:module :fftw-libs
:perform (asdf:load-op :after (op c)
(load-lisplab-lib
- cl-user::*lisplab-libfftw-path*))
+ cl-user::*lisplab-libfftw-path*)
+ (load-lisplab-lib
+ cl-user::*lisplab-libfftw-threads-path*))
:explain (asdf:load-op :after (op c)
(explain-lisplab-lib
- "FFTW"
- cl-user::*lisplab-libfftw-path*)))
+ "FFTW"
+ cl-user::*lisplab-libfftw-path*)
+ (explain-lisplab-lib
+ "FFTW threads"
+ cl-user::*lisplab-libfftw-threads-path*)))
(:file "fftw-ffi")
(:file "level3-fft-fftw")))))
Modified: src/fft/fftw-ffi.lisp
==============================================================================
--- src/fft/fftw-ffi.lisp (original)
+++ src/fft/fftw-ffi.lisp Tue Aug 25 15:34:30 2009
@@ -1,4 +1,4 @@
-;;; Foreign function interfaces for FFTW
+;;; Foreign function interfaces for FFTW version 3.
;;; Copyright (C) 2009 Joern Inge Vestgaarden
;;;
@@ -16,6 +16,9 @@
;;; with this program; if not, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+;;; TODO: the calls should be wrapped in unwind protect
+;;; to avoid memory leaks
+
(in-package :fftw-ffi)
(defconstant +double-float-bytes+ (truncate (sb-alien:ALIEN-SIZE sb-alien:double-float) 8))
@@ -60,7 +63,7 @@
;; TODO we should handle conditions to avoid mem-leaks
(let ((astart (* astart +double-float-bytes+))
(bstart (* bstart +double-float-bytes+)))
- (without-gcing
+ (with-pinned-objects (a b)
(let ((plan (|fftw_plan_dft_1d|
n
(sap+ (vector-sap a) astart)
@@ -74,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
- (without-gcing
+ (with-pinned-objects (in out)
(let ((plan (|fftw_plan_dft_2d|
n ; swap n and m due to row major order
m
@@ -87,3 +90,19 @@
out)
+;;;; Now multi-thread code
+
+(declaim (inline |fftw_init_threads|))
+(define-alien-routine |fftw_init_threads|
+ int)
+
+(declaim (inline |fftw_plan_with_nthreads|))
+(define-alien-routine |fftw_plan_with_nthreads|
+ void
+ (nthreads int))
+
+(declaim (inline |fftw_cleanup_threads|))
+(define-alien-routine |fftw_cleanup_threads|
+ void)
+
+
Modified: src/fft/level3-fft-fftw.lisp
==============================================================================
--- src/fft/level3-fft-fftw.lisp (original)
+++ src/fft/level3-fft-fftw.lisp Tue Aug 25 15:34:30 2009
@@ -37,17 +37,17 @@
fftw-ffi:+FFTW-ESTIMATE+)))
x)
-(defmethod fft1! ((x matrix-blas-zge))
+(defmethod fft1! ((x matrix-blas-zge) &key)
(if cl-user::*lisplab-libfftw-path*
(fft1!-forward-or-backward x fftw-ffi:+fftw-forward+)
(call-next-method)))
-(defmethod ifft1! ((x matrix-blas-zge))
+(defmethod ifft1! ((x matrix-blas-zge) &key)
(if cl-user::*lisplab-libfftw-path*
(fft1!-forward-or-backward x fftw-ffi:+fftw-backward+)
(call-next-method)))
-(defmethod fft2! ((x matrix-blas-zge))
+(defmethod fft2! ((x matrix-blas-zge) &key)
(if cl-user::*lisplab-libfftw-path*
(progn
(fftw-ffi:fftw-fft2
@@ -60,7 +60,7 @@
x)
(call-next-method)))
-(defmethod ifft2! ((x matrix-blas-zge))
+(defmethod ifft2! ((x matrix-blas-zge) &key)
(if cl-user::*lisplab-libfftw-path*
(progn
(fftw-ffi:fftw-fft2
Modified: src/fft/level3-fft-generic.lisp
==============================================================================
--- src/fft/level3-fft-generic.lisp (original)
+++ src/fft/level3-fft-generic.lisp Tue Aug 25 15:34:30 2009
@@ -28,28 +28,28 @@
;;;; Real matrices
-(defmethod fft1 ((x matrix-base-dge))
+(defmethod fft1 ((x matrix-base-dge) &key)
(fft1! (convert-to-matrix-zge x)))
-(defmethod ifft1 ((x matrix-base-dge))
+(defmethod ifft1 ((x matrix-base-dge) &key)
(ifft1! (convert-to-matrix-zge x)))
-(defmethod ifft2 ((x matrix-base-dge))
+(defmethod ifft2 ((x matrix-base-dge) &key)
(ifft2! (convert-to-matrix-zge x)))
-(defmethod fft2 ((x matrix-base-dge))
+(defmethod fft2 ((x matrix-base-dge) &key)
(fft2! (convert-to-matrix-zge x)))
;;; Complex matrices
-(defmethod fft1 ((x matrix-base-zge))
+(defmethod fft1 ((x matrix-base-zge) &key)
(fft1! (copy x)))
-(defmethod ifft1 ((x matrix-base-zge))
+(defmethod ifft1 ((x matrix-base-zge) &key)
(ifft1! (copy x)))
-(defmethod ifft2 ((x matrix-base-zge))
+(defmethod ifft2 ((x matrix-base-zge) &key)
(ifft2! (copy x)))
-(defmethod fft2 ((x matrix-base-zge))
+(defmethod fft2 ((x matrix-base-zge) &key)
(fft2! (copy x)))
Modified: src/fft/level3-fft-interface.lisp
==============================================================================
--- src/fft/level3-fft-interface.lisp (original)
+++ src/fft/level3-fft-interface.lisp Tue Aug 25 15:34:30 2009
@@ -21,28 +21,28 @@
;;;; Fourier stuff
-(defgeneric fft1 (x)
+(defgeneric fft1 (x &key)
(:documentation "Forward fast fourier transform on all columns"))
-(defgeneric fft1! (x)
+(defgeneric fft1! (x &key)
(:documentation "Forward fast fourier transform on all columns. Destructive"))
-(defgeneric ifft1 (x)
+(defgeneric ifft1 (x &key)
(:documentation "Inverse fast fourier transform on all columns"))
-(defgeneric ifft1! (x)
+(defgeneric ifft1! (x &key)
(:documentation "Inverse fast fourier transform on all columns. Destructive"))
-(defgeneric fft2 (x)
+(defgeneric fft2 (x &key)
(:documentation "Forward fast fourier transform on all rows and columns"))
-(defgeneric fft2! (x)
+(defgeneric fft2! (x &key)
(:documentation "Forward fast fourier transform on all rows and columns. Destructive"))
-(defgeneric ifft2 (x)
+(defgeneric ifft2 (x &key)
(:documentation "Inverse fast fourier transform on all rows and columns"))
-(defgeneric ifft2! (x)
+(defgeneric ifft2! (x &key)
(:documentation "Inverse fast fourier transform on all rows and columns. Destructive"))
(defgeneric fft-shift (x)
Modified: src/fft/level3-fft-zge.lisp
==============================================================================
--- src/fft/level3-fft-zge.lisp (original)
+++ src/fft/level3-fft-zge.lisp Tue Aug 25 15:34:30 2009
@@ -23,24 +23,23 @@
-
;;;; The implementing methods
-(defmethod fft1! ((x matrix-lisp-zge))
+(defmethod fft1! ((x matrix-lisp-zge) &key)
(assert (= 1 (logcount (rows x))))
(dotimes (i (cols x))
(fft-radix-2-blas-complex-store! :f (matrix-store x) (rows x) (* (rows x) i) 1))
x)
-(defmethod ifft1! ((x matrix-lisp-zge))
+(defmethod ifft1! ((x matrix-lisp-zge) &key)
(assert (= 1 (logcount (rows x))))
(dotimes (i (cols x))
(fft-radix-2-blas-complex-store! :r (matrix-store x) (rows x) (* (rows x) i) 1))
x)
-(defmethod fft2! ((x matrix-lisp-zge))
+(defmethod fft2! ((x matrix-lisp-zge) &key)
(assert (and (= 1 (logcount (rows x)))
(= 1 (logcount (cols x)))))
(fft1! x)
@@ -48,7 +47,7 @@
(fft-radix-2-blas-complex-store! :f (matrix-store x) (cols x) i (rows x)))
x)
-(defmethod ifft2! ((x matrix-lisp-zge))
+(defmethod ifft2! ((x matrix-lisp-zge) &key)
(assert (and (= 1 (logcount (rows x)))
(= 1 (logcount (cols x)))))
More information about the lisplab-cvs
mailing list