[gambit-list] Register usage

Bradley Lucier lucier at math.purdue.edu
Thu Sep 7 14:25:43 EDT 2006


Marc:

The code for the main loop of this function is scheduled in 35 cycles  
when target gvm registers is 20 and target arg registers is 8; it's  
scheduled in 113 cycles when gvm registers is 5 and arg registers is  
3 (the default).  This is with the compile command

gcc -mcpu=970 -m64  -no-cpp-precomp -Wall -W -Wno-unused -O1 -fno- 
math-errno -fschedule-insns2 -fno-trapping-math -fno-strict-aliasing - 
fwrapv -fomit-frame-pointer -fPIC -fno-common -bundle -flat_namespace  
-undefined suppress -I${GSC_CC_O_ARG1}include -D___DYNAMIC - 
D___SINGLE_HOST -o ${GSC_CC_O_ARG2} $* ${GSC_CC_O_ARG3} -save-temps - 
dR -freorder-blocks

in gsc-cc-o on my PowerMac G5.

This is a problem.

You know that lambda-lifting and register allocation don't work well  
together in the compiler.  This is a rather extreme example.  It's  
hard to look for faster algorithms when the simple ones are compiled  
to something that takes three times as long as it should take.

Brad

(define (direct-fft-recursive a W-table)

   ;; This is a direcct complex fft, using a decimation-in-time  
algorithm
   ;; with inputs in natural order and outputs in bit-reversed order.
   ;; The table of "twiddle" factors is in bit-reversed order.

   ;; this is from page 66 of Chu and George

   (let ((W (##f64vector 0. 0.)))

     (define (make-W W-table W K)
       ;; look at Colin Percival's FFT notes for how to calculate this.
       ;; this works, but I'll be damned if I know why.
       (cond ((##fixnum.even? K)
	     (let* ((K-index    K)
		    (K-index+1  (##fixnum.+ K-index 1))
		    (basic-real (##f64vector-ref W-table K-index))
		    (basic-imag (##f64vector-ref W-table K-index+1))
		    (result-real basic-real)
		    (result-imag basic-imag))
	       (##f64vector-set! W 0 result-real)
	       (##f64vector-set! W 1 result-imag)))
	    (else
	     (let* ((K-index     (##fixnum.bitwise-and K -2))
		    (K-index+1   (##fixnum.+ K-index 1))
		    (basic-real  (##f64vector-ref W-table K-index))
		    (basic-imag  (##f64vector-ref W-table K-index+1))
		    (result-real (##flonum.- basic-imag))
		    (result-imag basic-real))
	       (##f64vector-set! W 0 result-real)
	       (##f64vector-set! W 1 result-imag)))))

     (define (main-loop M N K SizeOfGroup)
       (##declare (not interrupts-enabled))
       (let inner-loop ((K K)
		       (JFirst M))
	(if (##fixnum.< JFirst N)
	    (let* ((JLast  (##fixnum.+ JFirst SizeOfGroup)))
	      (make-W W-table W K)
	      (let J-loop ((J JFirst))
		(if (##fixnum.< J JLast)
		    (let ((J+1             (##fixnum.+ J 1            ))
			  (J+SizeOfGroup   (##fixnum.+ J   SizeOfGroup))
			  (J+SizeOfGroup+1 (##fixnum.+ J 1 SizeOfGroup)))
		      (let ((W-real               (##f64vector-ref W 0))
			    (W-imag               (##f64vector-ref W 1))
			    (a_J-real             (##f64vector-ref a J  ))
			    (a_J-imag             (##f64vector-ref a J+1))
			    (a_J+SizeOfGroup-real (##f64vector-ref a J+SizeOfGroup  ))
			    (a_J+SizeOfGroup-imag (##f64vector-ref a J+SizeOfGroup+1)))
			(let ((Temp-real (##flonum.- (##flonum.* W-real a_J+SizeOfGroup-real)
						     (##flonum.* W-imag a_J+SizeOfGroup-imag)))
			      (Temp-imag (##flonum.+ (##flonum.* W-real a_J+SizeOfGroup-imag)
						     (##flonum.* W-imag a_J+SizeOfGroup-real))))
			  (let ((Result-J-real             (##flonum.+ a_J-real Temp-real))
				(Result-J-imag             (##flonum.+ a_J-imag Temp-imag))
				(Result-J+SizeOfGroup-real (##flonum.- a_J-real Temp-real))
				(Result-J+SizeOfGroup-imag (##flonum.- a_J-imag Temp-imag)))
			    (##f64vector-set! a J               Result-J-real)
			    (##f64vector-set! a J+1             Result-J-imag)
			    (##f64vector-set! a J+SizeOfGroup   Result-J+SizeOfGroup-real)
			    (##f64vector-set! a J+SizeOfGroup+1 Result-J+SizeOfGroup-imag)
			    (J-loop (##fixnum.+ J 2))))))
		    (inner-loop (##fixnum.+ K 1)
				(##fixnum.+ JLast SizeOfGroup))))))))

     (define (recursive-bit M N K SizeOfGroup)
       (if (##fixnum.<= 2 SizeOfGroup)
	  (begin
	    (main-loop M N K SizeOfGroup)
	    (if (##fixnum.< 2048 (##fixnum.- N M))
		(begin
		  (recursive-bit M
				 (##fixnum.+ M SizeOfGroup)
				 (##fixnum.* K 2)
				 (##fixnum.quotient SizeOfGroup 2))
		  (recursive-bit (##fixnum.+ M SizeOfGroup)
				 N
				 (##fixnum.+ (##fixnum.* K 2) 1)
				 (##fixnum.quotient SizeOfGroup 2)))
		(recursive-bit M
			       N
			       (##fixnum.* K 2)
			       (##fixnum.quotient SizeOfGroup 2))))))

     (recursive-bit 0 (##f64vector-length a) 0 (##fixnum.quotient  
(##f64vector-length a) 2))))



More information about the Gambit-list mailing list