This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp".
The branch, master has been updated via 8f5f6abc07afeb0822ae48b3615c83734960dda6 (commit) from 3ff38ffa166153b7266ecdb04a3ff59b85b4c0b4 (commit)
Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below.
- Log ----------------------------------------------------------------- commit 8f5f6abc07afeb0822ae48b3615c83734960dda6 Author: Raymond Toy toy.raymond@gmail.com Date: Wed Oct 1 21:25:58 2014 -0700
Micro-optimize SCALE-FLOAT to use multiplication when possible.
If the exponent (second arg of SCALE-FLOAT) is such that 2^exponent can be represented as a float (single or double), we can implement SCALE-FLOAT using a multiplication by 2^exponent, since multiplication by 2^exponent is exact.
* src/compiler/float-tran.lisp: * Update deftransforms for SCALE-FLOAT to do a multiply when possible. * tests/float-tran.lisp: * Add tests to make sure the deftransforms for SCALE-FLOAT are applied appropriately.
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 23aa93f..6efe701 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -488,21 +488,50 @@ '(integer-decode-double-float x))
(deftransform scale-float ((f ex) (single-float *) * :when :both) - (if (and (backend-featurep :x86) - (not (backend-featurep :sse2)) - (csubtypep (continuation-type ex) - (specifier-type '(signed-byte 32))) - (not (byte-compiling))) - '(coerce (%scalbn (coerce f 'double-float) ex) 'single-float) - '(scale-single-float f ex))) + (cond ((and (backend-featurep :x86) + (not (backend-featurep :sse2)) + (csubtypep (continuation-type ex) + (specifier-type '(signed-byte 32))) + (not (byte-compiling))) + '(coerce (%scalbn (coerce f 'double-float) ex) 'single-float)) + ((csubtypep (continuation-type ex) + (specifier-type `(integer #.(- vm:single-float-normal-exponent-min + vm:single-float-bias + vm:single-float-digits) + #.(- vm:single-float-normal-exponent-max + vm:single-float-bias + 1)))) + ;; The exponent is such that 2^ex will fit in a single-float. + ;; Thus, scale-float can be done multiplying by a suitable + ;; constant. + `(* f (kernel:make-single-float (dpb (+ ex (1+ vm:single-float-bias)) + vm:single-float-exponent-byte + (kernel:single-float-bits 1f0))))) + (t + '(scale-single-float f ex))))
(deftransform scale-float ((f ex) (double-float *) * :when :both) - (if (and (backend-featurep :x86) - (not (backend-featurep :sse2)) - (csubtypep (continuation-type ex) - (specifier-type '(signed-byte 32)))) - '(%scalbn f ex) - '(scale-double-float f ex))) + (cond ((and (backend-featurep :x86) + (not (backend-featurep :sse2)) + (csubtypep (continuation-type ex) + (specifier-type '(signed-byte 32)))) + '(%scalbn f ex)) + ((csubtypep (continuation-type ex) + (specifier-type `(integer #.(- vm:double-float-normal-exponent-min + vm:double-float-bias + vm:double-float-digits) + #.(- vm:double-float-normal-exponent-max + vm:double-float-bias + 1)))) + ;; The exponent is such that 2^ex will fit in a double-float. + ;; Thus, scale-float can be done multiplying by a suitable + ;; constant. + `(* f (kernel:make-double-float (dpb (+ ex (1+ vm:double-float-bias)) + vm:double-float-exponent-byte + (kernel::double-float-bits 1d0)) + 0))) + (t + '(scale-double-float f ex))))
;;; toy@rtp.ericsson.se: ;;; diff --git a/tests/float-tran.lisp b/tests/float-tran.lisp index 9b84659..8eb1990 100644 --- a/tests/float-tran.lisp +++ b/tests/float-tran.lisp @@ -152,3 +152,61 @@ ;; test-fun should have transformed (log x 10) to kernel:%log10 (assert-true (search "log10" (with-output-to-string (*standard-output*) (disassemble test-fun-good-2)))))) + +(define-test scale-float-transform.single + (let ((xfrm-scale + (compile nil + (lambda (x n) + (declare (single-float x) + (type (integer -149 127) n)) + (scale-float x n)))) + (scale + (compile nil + (lambda (x n) + (declare (single-float x) + (type (signed-byte 32) n)) + (scale-float x n))))) + ;; If the deftransform for scale-float was applied, (scale-float + ;; most-positive-single-float 2) is done as a multiplication which + ;; will overflow. The operation will be '*. If the deftransform + ;; was not applied, the overflow will still be signaled, but the + ;; operation will be 'scale-float. + (assert-eql '* + (handler-case + (funcall xfrm-scale most-positive-single-float 2) + (arithmetic-error (c) + (arithmetic-error-operation c)))) + (assert-eql 'scale-float + (handler-case + (funcall scale most-positive-single-float 2) + (arithmetic-error (c) + (arithmetic-error-operation c)))))) + +(define-test scale-float-transform.double + (let ((xfrm-scale + (compile nil + (lambda (x n) + (declare (double-float x) + (type (integer -1074 1023) n)) + (scale-float x n)))) + (scale + (compile nil + (lambda (x n) + (declare (double-float x) + (type (signed-byte 32) n)) + (scale-float x n))))) + ;; If the deftransform for scale-float was applied, (scale-float + ;; most-positive-double-float 2) is done as a multiplication which + ;; will overflow. The operation will be '*. If the deftransform + ;; was not applied, the overflow will still be signaled, but the + ;; operation will be 'scale-float. + (assert-eql '* + (handler-case + (funcall xfrm-scale most-positive-double-float 2) + (arithmetic-error (c) + (arithmetic-error-operation c)))) + (assert-eql 'scale-float + (handler-case + (funcall scale most-positive-double-float 2) + (arithmetic-error (c) + (arithmetic-error-operation c))))))
-----------------------------------------------------------------------
Summary of changes: src/compiler/float-tran.lisp | 55 +++++++++++++++++++++++++++++---------- tests/float-tran.lisp | 58 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 100 insertions(+), 13 deletions(-)
hooks/post-receive