Performance and Evaluation of Lisp Systems - Dreamsongs

194
l6 (cond ((< k j)
(setq j (- j k) k (/ k 2))
(go l6)))
(setq j (+ j k)
i (1+ i))
(cond ((< i n)
(go l3)))
;;; loop thru stages
(do ((l 1 (1+ l)))
((> l m))
(setq le (expt 2 l)
le1 (floor le 2) ur 1.0
ui 0. wr (cos (/ pi (float le1)))
wi (sin (/ pi (float le1))))
;;; loop thru butterflies
(do ((j 1 (1+ j)))
((> j le1))
;;; do a butterfly
(do ((i j (+ i le)))
((> i n))
(setq ip (+ i le1)
tr (- (* (aref ar ip) ur)
(* (aref ai ip) ui))
ti (+ (* (aref ar ip) ui)
(* (aref ai ip) ur)))
(setf (aref ar ip) (- (aref ar i) tr))
(setf (aref ai ip) (- (aref ai i) ti))
(setf (aref ar i) (+ (aref ar i) tr))
(setf (aref ai i) (+ (aref ai i) ti))))
(setq tr (- (* ur wr) (* ui wi))
ti (+ (* ur wi) (* ui wr))
ur tr ui ti))
(return t)))
;;; the timer, which does 10 calls on fft
(defmacro fft-bench ()
’(do ((ntimes 0 (1+ ntimes)))
((= ntimes 10.))
(fft re im)))
;;; call: (fft-bench)