Skip to content

Commit

Permalink
Parameterisable blocking factor
Browse files Browse the repository at this point in the history
  • Loading branch information
@pkhuong
pkhuong committed Dec 28, 2011
1 parent 4bf71cf commit 16104f3
Showing 1 changed file with 42 additions and 32 deletions.
74 changes: 42 additions & 32 deletions medium-fft.lisp
View file
@@ -1,4 +1,4 @@
(defconstant +blocking-factor+ 4) (defconstant +default-blocking-factor+ 4)


(defun gen-simple-fft/medium (size (defun gen-simple-fft/medium (size
&key (dst 'dst) &key (dst 'dst)
Expand All @@ -10,64 +10,66 @@
(strides 1) (strides 1)
(strided 1) (strided 1)
(twiddle 'twiddle) (twiddle 'twiddle)
(cooley-tukey 'cooley-tukey)) (cooley-tukey 'cooley-tukey)
(blocking-factor +default-blocking-factor+))
(assert (evenp (integer-length (1- size)))) (assert (evenp (integer-length (1- size))))
(assert (= 1 strided)) (assert (= 1 strided))
(let ((half-size (ash 1 (truncate (integer-length (1- size)) (let ((half-size (ash 1 (truncate (integer-length (1- size))
2)))) 2))))
(assert (<= blocking-factor half-size))
`(flet ((sub-fft (dst src twiddle `(flet ((sub-fft (dst src twiddle
startd starts) startd starts)
(declare (type complex-sample-array dst src twiddle) (declare (type complex-sample-array dst src twiddle)
(type index startd starts)) (type index startd starts))
,(gen-fft/small half-size))) ,(gen-fft/small half-size)))
;; copy columns from src to tmp ;; copy columns from src to tmp
(loop for i of-type index below ,half-size by ,+blocking-factor+ (loop for i of-type index below ,half-size by ,blocking-factor
for j of-type index from 0 by ,(* +blocking-factor+ half-size) for j of-type index from 0 by ,(* blocking-factor half-size)
do (loop for count of-type index from ,half-size above 0 do (loop for count of-type index from ,half-size above 0
for j of-type index from ,startt for j of-type index from ,startt
for k of-type index from (+ (* ,strides i) ,starts) for k of-type index from (+ (* ,strides i) ,starts)
by (* ,strides ,half-size) by (* ,strides ,half-size)
do (setf ,@(loop do (setf ,@(loop
for block below +blocking-factor+ for block below blocking-factor
append append
`((ref ,tmp (+ j ,(* block half-size))) `((ref ,tmp (+ j ,(* block half-size)))
(ref ,src (+ k (* ,block ,strides))))))) (ref ,src (+ k (* ,block ,strides)))))))
do (progn do (progn
;; FFT columns in scratch space ;; FFT columns in scratch space
;; write result to dst, in rows ;; write result to dst, in rows
,@(loop ,@(loop
for block below +blocking-factor+ for block below blocking-factor
collect collect
`(sub-fft ,dst ,tmp ,twiddle `(sub-fft ,dst ,tmp ,twiddle
(+ j ,startd ,(* block half-size)) (+ j ,startd ,(* block half-size))
(+ ,startt ,(* block half-size)))) (+ ,startt ,(* block half-size))))
(loop for i of-type index from (+ j ,startd) (loop for i of-type index from (+ j ,startd)
for idx of-type index from j for idx of-type index from j
for count below ,(* half-size +blocking-factor+) for count below ,(* half-size blocking-factor)
do (setf (ref ,dst i) do (setf (ref ,dst i)
(* (ref ,dst i) (* (ref ,dst i)
(ref ,cooley-tukey idx)))))) (ref ,cooley-tukey idx))))))
(loop for i of-type half-index below ,half-size by +blocking-factor+ do (loop for i of-type half-index below ,half-size by blocking-factor do
(loop for count of-type half-index from ,half-size above 0 (loop for count of-type half-index from ,half-size above 0
for j of-type index from ,startt for j of-type index from ,startt
for k of-type index from (+ i ,startd) by ,half-size for k of-type index from (+ i ,startd) by ,half-size
do (setf ,@(loop do (setf ,@(loop
for block below +blocking-factor+ for block below blocking-factor
append `((ref ,tmp (+ j ,(* block half-size))) append `((ref ,tmp (+ j ,(* block half-size)))
(ref ,dst (+ k ,block)))))) (ref ,dst (+ k ,block))))))
do do
(progn (progn
,@(loop for block below +blocking-factor+ ,@(loop for block below blocking-factor
collect collect
`(sub-fft ,tmp ,tmp ,twiddle `(sub-fft ,tmp ,tmp ,twiddle
(+ ,startt ,(* +blocking-factor+ half-size) (+ ,startt ,(* blocking-factor half-size)
,(* block half-size)) ,(* block half-size))
(+ ,startt ,(* block half-size)))) (+ ,startt ,(* block half-size))))
(loop for count of-type half-index from ,half-size above 0 (loop for count of-type half-index from ,half-size above 0
for j of-type index from (+ ,startt ,(* +blocking-factor+ half-size)) for j of-type index from (+ ,startt ,(* blocking-factor half-size))
for k of-type index from (+ i ,startd) by ,half-size for k of-type index from (+ i ,startd) by ,half-size
do (setf ,@(loop do (setf ,@(loop
for block below +blocking-factor+ for block below blocking-factor
append `((ref ,dst (+ k ,block)) append `((ref ,dst (+ k ,block))
(ref ,tmp (ref ,tmp
(+ j ,(* block half-size))))))))) (+ j ,(* block half-size)))))))))
Expand All @@ -83,11 +85,14 @@
(strides 1) (strides 1)
(strided 1) (strided 1)
(twiddle 'twiddle) (twiddle 'twiddle)
(cooley-tukey 'cooley-tukey)) (cooley-tukey 'cooley-tukey)
(blocking-factor +default-blocking-factor+))
(let* ((size1 (ash 1 (truncate (integer-length (1- size)) (let* ((size1 (ash 1 (truncate (integer-length (1- size))
2))) 2)))
(size2 (/ size size1))) (size2 (/ size size1)))
(assert (integerp size2)) (assert (integerp size2))
(assert (<= blocking-factor size1))
(assert (<= blocking-factor size2))
`(progn `(progn
(flet ((rec (dst src startd starts twiddle) (flet ((rec (dst src startd starts twiddle)
,(gen-fft/small size2 ,(gen-fft/small size2
Expand All @@ -96,27 +101,27 @@
:starts 'starts :starts 'starts
:strided strided))) :strided strided)))
;; copy columns to scratch ;; copy columns to scratch
(loop for i of-type index below ,size1 by +blocking-factor+ (loop for i of-type index below ,size1 by blocking-factor
for j of-type index from 0 by ,(* +blocking-factor+ size2) for j of-type index from 0 by ,(* blocking-factor size2)
do (loop for count of-type index from ,size2 above 0 do (loop for count of-type index from ,size2 above 0
for j of-type index from ,startt for j of-type index from ,startt
for k of-type index from (+ (* i ,strides) ,starts) for k of-type index from (+ (* i ,strides) ,starts)
by (* ,size1 ,strides) by (* ,size1 ,strides)
do (setf ,@(loop do (setf ,@(loop
for block below +blocking-factor+ for block below blocking-factor
append `((ref ,tmp (+ j ,(* block size2))) append `((ref ,tmp (+ j ,(* block size2)))
(ref ,src (+ k (* ,block ,strides))))))) (ref ,src (+ k (* ,block ,strides)))))))
do (progn do (progn
,@(loop ,@(loop
for block below +blocking-factor+ for block below blocking-factor
collect `(rec ,dst ,tmp collect `(rec ,dst ,tmp
(+ (* ,strided (+ j ,(* block size2))) (+ (* ,strided (+ j ,(* block size2)))
,startd) ,startd)
(+ ,startt ,(* block size2)) (+ ,startt ,(* block size2))
,twiddle)) ,twiddle))
(loop for i of-type index from (+ (* j ,strided) ,startd) by ,strided (loop for i of-type index from (+ (* j ,strided) ,startd) by ,strided
for idx of-type index from j for idx of-type index from j
for count of-type index below ,(* size2 +blocking-factor+) for count of-type index below ,(* size2 blocking-factor)
do (setf (ref ,dst i) do (setf (ref ,dst i)
(* (ref ,dst i) (* (ref ,dst i)
(ref ,cooley-tukey idx))))))) (ref ,cooley-tukey idx)))))))
Expand All @@ -125,32 +130,35 @@
:dst 'vec :src 'vec :twiddle 'twiddle :dst 'vec :src 'vec :twiddle 'twiddle
:startd 'startd :startd 'startd
:starts 'starts))) :starts 'starts)))
(loop for i of-type index below ,size2 by +blocking-factor+ do (loop for i of-type index below ,size2 by blocking-factor do
(loop for count of-type half-index from ,size1 above 0 (loop for count of-type half-index from ,size1 above 0
for j of-type index from ,startt for j of-type index from ,startt
for k of-type index from (+ (* i ,strided) ,startd) for k of-type index from (+ (* i ,strided) ,startd)
by (* ,size2 ,strided) by (* ,size2 ,strided)
do (setf ,@(loop do (setf ,@(loop
for block below +blocking-factor+ for block below blocking-factor
append `((ref ,tmp (+ j ,(* block size1))) append
(ref ,dst (+ k (* ,block ,strided))))))) `((ref ,tmp (+ j ,(* block size1)))
(ref ,dst (+ k (* ,block ,strided)))))))
do (progn do (progn
,@(loop ,@(loop
for block below +blocking-factor+ for block below blocking-factor
collect `(rec ,tmp collect `(rec ,tmp
(+ ,startt ,(* +blocking-factor+ size1) (+ ,startt ,(* blocking-factor size1)
,(* block size1)) ,(* block size1))
(+ ,startt ,(* block size1)))) (+ ,startt ,(* block size1))))
(loop for count of-type half-index from ,size1 above 0 (loop for count of-type half-index from ,size1 above 0
for j of-type index for j of-type index
from (+ ,startt ,(* +blocking-factor+ size1)) from (+ ,startt ,(* blocking-factor size1))
for k of-type index from (+ (* i ,strided) ,startd) for k of-type index from (+ (* i ,strided) ,startd)
by (* ,size2 ,strided) by (* ,size2 ,strided)
do (setf do (setf
,@(loop for block below +blocking-factor+ ,@(loop
append `((ref ,dst (+ k ,block)) for block below blocking-factor
(ref ,tmp (+ j (* ,strided append
,(* block size1))))))))))) `((ref ,dst (+ k ,block))
(ref ,tmp (+ j (* ,strided
,(* block size1)))))))))))
dst))) dst)))


(defun gen-fft/medium (size &rest args (defun gen-fft/medium (size &rest args
Expand All @@ -163,11 +171,13 @@
(strides 1) (strides 1)
(strided 1) (strided 1)
(twiddle 'twiddle) (twiddle 'twiddle)
(cooley-tukey 'cooley-tukey)) (cooley-tukey 'cooley-tukey)
(blocking-factor +default-blocking-factor+))
(declare (ignore dst src tmp (declare (ignore dst src tmp
startd starts startt startd starts startt
strides strides
twiddle cooley-tukey)) twiddle cooley-tukey
blocking-factor))
(if (and (evenp (integer-length (1- size))) (if (and (evenp (integer-length (1- size)))
(eql strided 1)) (eql strided 1))
(apply 'gen-simple-fft/medium size args) (apply 'gen-simple-fft/medium size args)
Expand Down

0 comments on commit 16104f3

Please sign in to comment.