diff --git a/compiler/x86/float-sse2.lisp b/compiler/x86/float-sse2.lisp index a9e3fe37e79abd58589291ecca22b298702f71c4..318b8282bf0fc68d2585769fb331b24cd1ccbeb2 100644 --- a/compiler/x86/float-sse2.lisp +++ b/compiler/x86/float-sse2.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.1.2.8.2.3 2008/10/09 19:10:32 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.1.2.8.2.4 2008/10/09 21:34:20 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2016,3 +2016,47 @@ (inst addsubpd t1 t2) ; t2 = a*d+b*c|a*c-b*d (inst movapd r t1))) +(define-vop (*/complex-double-float) + (:translate *) + (:args (x :scs (complex-double-reg)) + (y :scs (complex-double-reg))) + (:arg-types complex-double-float complex-double-float) + (:results (r :scs (complex-double-reg))) + (:result-types complex-double-float) + (:policy :fast-safe) + (:temporary (:scs (complex-double-reg)) t0 t1 t2) + (:temporary (:scs (complex-double-stack)) stemp) + (:generator 1 + ;; Basic algorithm from the paper "The Microarchitecture of the + ;; Intel Pentium 4 Processor on 90nm Technololgy" + + ;; x = a+b*i = b|a + ;; y = c+d*i = d|c + ;; r = a*c-b*d + i*(a*d+b*c) + (inst movapd t0 x) ; t0 = b|a + (inst movapd t1 y) ; t1 = d|c + (inst movapd t2 y) ; t2 = d|c + (inst unpcklpd t1 t1) ; t1 = c|c + (inst unpckhpd t2 t2) ; t2 = d|d + (inst mulpd t1 t0) ; t1 = b*c|a*c + (inst mulpd t2 t0) ; t2 = b*d|a*d + ;; Set t0 to flip the sign of the high part. This needs to be + ;; done better. We basically store out #x8000000000000000 in + ;; memory and load it into t0. Then move it to the high part. + ;; (Note that #x8000...0000 has the same bit pattern as -0d0.) + (inst mov (make-ea :dword :base ebp-tn + :disp (- (* (+ (tn-offset stemp) 2) + vm:word-bytes))) + 0) + (inst mov (make-ea :dword :base ebp-tn + :disp (- (* (+ (tn-offset stemp) 1) + vm:word-bytes))) + #x80000000) + (inst movq t0 (make-ea :dword :base ebp-tn + :disp (- (* (+ (tn-offset stemp) 2) + vm:word-bytes)))) + (inst shufpd t0 t0 1) + (inst xorpd t2 t0) ; t2 = -b*d|a*d + (inst shufpd t2 t2 1) ; t2 = a*d|-b*d + (inst addpd t2 t1) ; t2 = a*d+b*c | a*c-b*d + (inst movapd r t2)))