Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler assem.lisp, 1.39, 1.40 float-tran.lisp, 1.45, 1.46 srctran.lisp, 1.168, 1.169
|
From: Paul K. <pk...@us...> - 2009-06-25 15:37:54
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv7140/src/compiler Modified Files: assem.lisp float-tran.lisp srctran.lisp Log Message: 1.0.29.44: Complex float improvements * On all platforms: - Slightly more stable complex-complex float (double and single) division; - New transform for real-complex division; - complex-real and real-complex float addition and subtraction behave as though the real was first upgraded to a complex, thus losing the sign of any imaginary zero. * On x86-64 - Complexes floats are represented packed in a single SSE register; - VOPs for all four arithmetic operations, complex-complex, but also complex-real and real-complex, except for complex-complex and real-complex division; - VOPs for =, negate and conjugate of complexes (complex-real and complex-complex); - VOPs for EQL of floats (real and complexes). - Full register moves for float values in SSE registers should also speed scalar operations up. Index: assem.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/assem.lisp,v retrieving revision 1.39 retrieving revision 1.40 diff -u -d -r1.39 -r1.40 --- assem.lisp 24 Apr 2009 11:38:10 -0000 1.39 +++ assem.lisp 25 Jun 2009 15:37:05 -0000 1.40 @@ -107,7 +107,7 @@ #!+sb-dyncount (collect-dynamic-statistics nil)) (sb!c::defprinter (segment) - name) + type) (declaim (inline segment-current-index)) (defun segment-current-index (segment) Index: float-tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/float-tran.lisp,v retrieving revision 1.45 retrieving revision 1.46 diff -u -d -r1.45 -r1.46 --- float-tran.lisp 25 Jun 2009 11:26:57 -0000 1.45 +++ float-tran.lisp 25 Jun 2009 15:37:05 -0000 1.46 @@ -1178,27 +1178,45 @@ ;;; of complex operation VOPs. (macrolet ((frob (type) `(progn + (deftransform complex ((r) (,type)) + '(complex r ,(coerce 0 type))) + (deftransform complex ((r i) (,type (and real (not ,type)))) + '(complex r (truly-the ,type (coerce i ',type)))) + (deftransform complex ((r i) ((and real (not ,type)) ,type)) + '(complex (truly-the ,type (coerce r ',type)) i)) ;; negation + #!-complex-float-vops (deftransform %negate ((z) ((complex ,type)) *) '(complex (%negate (realpart z)) (%negate (imagpart z)))) ;; complex addition and subtraction + #!-complex-float-vops (deftransform + ((w z) ((complex ,type) (complex ,type)) *) '(complex (+ (realpart w) (realpart z)) (+ (imagpart w) (imagpart z)))) + #!-complex-float-vops (deftransform - ((w z) ((complex ,type) (complex ,type)) *) '(complex (- (realpart w) (realpart z)) (- (imagpart w) (imagpart z)))) ;; Add and subtract a complex and a real. + #!-complex-float-vops (deftransform + ((w z) ((complex ,type) real) *) - '(complex (+ (realpart w) z) (imagpart w))) + `(complex (+ (realpart w) z) + (+ (imagpart w) ,(coerce 0 ',type)))) + #!-complex-float-vops (deftransform + ((z w) (real (complex ,type)) *) - '(complex (+ (realpart w) z) (imagpart w))) + `(complex (+ (realpart w) z) + (+ (imagpart w) ,(coerce 0 ',type)))) ;; Add and subtract a real and a complex number. + #!-complex-float-vops (deftransform - ((w z) ((complex ,type) real) *) - '(complex (- (realpart w) z) (imagpart w))) + `(complex (- (realpart w) z) + (- (imagpart w) ,(coerce 0 ',type)))) + #!-complex-float-vops (deftransform - ((z w) (real (complex ,type)) *) - '(complex (- z (realpart w)) (- (imagpart w)))) + `(complex (- z (realpart w)) + (- ,(coerce 0 ',type) (imagpart w)))) ;; Multiply and divide two complex numbers. + #!-complex-float-vops (deftransform * ((x y) ((complex ,type) (complex ,type)) *) '(let* ((rx (realpart x)) (ix (imagpart x)) @@ -1207,39 +1225,81 @@ (complex (- (* rx ry) (* ix iy)) (+ (* rx iy) (* ix ry))))) (deftransform / ((x y) ((complex ,type) (complex ,type)) *) + #!-complex-float-vops '(let* ((rx (realpart x)) (ix (imagpart x)) (ry (realpart y)) (iy (imagpart y))) (if (> (abs ry) (abs iy)) (let* ((r (/ iy ry)) - (dn (* ry (+ 1 (* r r))))) + (dn (+ ry (* r iy)))) (complex (/ (+ rx (* ix r)) dn) (/ (- ix (* rx r)) dn))) (let* ((r (/ ry iy)) - (dn (* iy (+ 1 (* r r))))) + (dn (+ iy (* r ry)))) (complex (/ (+ (* rx r) ix) dn) - (/ (- (* ix r) rx) dn)))))) + (/ (- (* ix r) rx) dn))))) + #!+complex-float-vops + `(let* ((cs (conjugate (sb!vm::swap-complex x))) + (ry (realpart y)) + (iy (imagpart y))) + (if (> (abs ry) (abs iy)) + (let* ((r (/ iy ry)) + (dn (+ ry (* r iy)))) + (/ (+ x (* cs r)) dn)) + (let* ((r (/ ry iy)) + (dn (+ iy (* r ry)))) + (/ (+ (* x r) cs) dn))))) ;; Multiply a complex by a real or vice versa. + #!-complex-float-vops (deftransform * ((w z) ((complex ,type) real) *) '(complex (* (realpart w) z) (* (imagpart w) z))) + #!-complex-float-vops (deftransform * ((z w) (real (complex ,type)) *) '(complex (* (realpart w) z) (* (imagpart w) z))) - ;; Divide a complex by a real. + ;; Divide a complex by a real or vice versa. + #!-complex-float-vops (deftransform / ((w z) ((complex ,type) real) *) '(complex (/ (realpart w) z) (/ (imagpart w) z))) + (deftransform / ((x y) (,type (complex ,type)) *) + #!-complex-float-vops + '(let* ((ry (realpart y)) + (iy (imagpart y))) + (if (> (abs ry) (abs iy)) + (let* ((r (/ iy ry)) + (dn (+ ry (* r iy)))) + (complex (/ x dn) + (/ (- (* x r)) dn))) + (let* ((r (/ ry iy)) + (dn (+ iy (* r ry)))) + (complex (/ (* x r) dn) + (/ (- x) dn))))) + #!+complex-float-vops + '(let* ((ry (realpart y)) + (iy (imagpart y))) + (if (> (abs ry) (abs iy)) + (let* ((r (/ iy ry)) + (dn (+ ry (* r iy)))) + (/ (complex x (- (* x r))) dn)) + (let* ((r (/ ry iy)) + (dn (+ iy (* r ry)))) + (/ (complex (* x r) (- x)) dn))))) ;; conjugate of complex number + #!-complex-float-vops (deftransform conjugate ((z) ((complex ,type)) *) '(complex (realpart z) (- (imagpart z)))) ;; CIS (deftransform cis ((z) ((,type)) *) '(complex (cos z) (sin z))) ;; comparison + #!-complex-float-vops (deftransform = ((w z) ((complex ,type) (complex ,type)) *) '(and (= (realpart w) (realpart z)) (= (imagpart w) (imagpart z)))) + #!-complex-float-vops (deftransform = ((w z) ((complex ,type) real) *) '(and (= (realpart w) z) (zerop (imagpart w)))) + #!-complex-float-vops (deftransform = ((w z) (real (complex ,type)) *) '(and (= (realpart z) w) (zerop (imagpart z))))))) Index: srctran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v retrieving revision 1.168 retrieving revision 1.169 diff -u -d -r1.168 -r1.169 --- srctran.lisp 25 Jun 2009 15:00:34 -0000 1.168 +++ srctran.lisp 25 Jun 2009 15:37:05 -0000 1.169 @@ -3499,7 +3499,13 @@ (cond ((or (and (csubtypep x-type (specifier-type 'float)) (csubtypep y-type (specifier-type 'float))) (and (csubtypep x-type (specifier-type '(complex float))) - (csubtypep y-type (specifier-type '(complex float))))) + (csubtypep y-type (specifier-type '(complex float)))) + #!+complex-float-vops + (and (csubtypep x-type (specifier-type '(or single-float (complex single-float)))) + (csubtypep y-type (specifier-type '(or single-float (complex single-float))))) + #!+complex-float-vops + (and (csubtypep x-type (specifier-type '(or double-float (complex double-float)))) + (csubtypep y-type (specifier-type '(or double-float (complex double-float)))))) ;; They are both floats. Leave as = so that -0.0 is ;; handled correctly. (give-up-ir1-transform)) |