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 07e2d61f67dbd0e099c256052ba70358125cc008 (commit) from 622b5df431a87ae3c8a816b7c569f5c5ef85a6d7 (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 07e2d61f67dbd0e099c256052ba70358125cc008 Author: Raymond Toy <toy.raymond@gmail.com> Date: Mon Oct 21 18:10:13 2013 -0700 Enable micro-optimization of fast-unary-ftruncate and double-float-bits for x86/sse2. This gives x86 the same micro-optimizations that were available for sparc and ppc. o code/kernel.lisp: o Enable fast double-float-bits using the vop instead of calling double-float-high-bits/double-float-low-bits. o compiler/float-tran.lisp: o Make fast-unary-ftruncate known to compiler and enable optimizer for it. o Make double-float-bits known to compiler o compiler/x86/float-sse2.lisp: o Implement fast-unary-ftruncate for singles and doubles. o Implement double-float-bits. diff --git a/src/code/kernel.lisp b/src/code/kernel.lisp index eaac29b..a67f7f7 100644 --- a/src/code/kernel.lisp +++ b/src/code/kernel.lisp @@ -180,10 +180,10 @@ #+long-float (defun long-float-low-bits (x) (long-float-low-bits x)) -#+(or sparc ppc) +#+(or sparc ppc (and x86 sse2)) (defun double-float-bits (x) (double-float-bits x)) -#-(or sparc ppc) +#-(or sparc ppc (and x86 sse2)) (defun double-float-bits (x) (values (double-float-high-bits x) (double-float-low-bits x))) diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 639ac8a..a107e79 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -192,12 +192,12 @@ '(let ((res (%unary-ftruncate (/ x y)))) (values res (- x (* y res))))) -#+sparc +#+(or sparc (and x86 sse2)) (defknown fast-unary-ftruncate ((or single-float double-float)) (or single-float double-float) (movable foldable flushable)) -#+sparc +#+(or sparc (and x86 sse2)) (defoptimizer (fast-unary-ftruncate derive-type) ((f)) (one-arg-derive-type f #'(lambda (n) @@ -224,14 +224,16 @@ (if (and (numberp lo) (numberp hi) (< limit-lo lo) (< hi limit-hi)) - #-sparc '(let ((result (coerce (%unary-truncate x) ',ftype))) - (if (zerop result) - (* result x) - result)) - #+sparc '(let ((result (fast-unary-ftruncate x))) - (if (zerop result) - (* result x) - result)) + #-(or sparc (and x86 sse2)) + '(let ((result (coerce (%unary-truncate x) ',ftype))) + (if (zerop result) + (* result x) + result)) + #+(or sparc (and x86 sse2)) + '(let ((result (fast-unary-ftruncate x))) + (if (zerop result) + (* result x) + result)) '(,func x)))))) (frob single-float %unary-ftruncate/single-float) (frob double-float %unary-ftruncate/double-float)) @@ -355,7 +357,7 @@ (defknown double-float-low-bits (double-float) (unsigned-byte 32) (movable foldable flushable)) -#+(or sparc ppc) +#+(or sparc ppc (and x86 sse2)) (defknown double-float-bits (double-float) (values (signed-byte 32) (unsigned-byte 32)) (movable foldable flushable)) diff --git a/src/compiler/x86/float-sse2.lisp b/src/compiler/x86/float-sse2.lisp index f54f072..27fddca 100644 --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -1038,6 +1038,32 @@ (frob %unary-round cvtss2si single-reg single-float t) (frob %unary-round cvtsd2si double-reg double-float t)) +(define-vop (fast-unary-ftruncate/single-float) + (:args (x :scs (single-reg))) + (:arg-types single-float) + (:results (r :scs (single-reg))) + (:result-types single-float) + (:policy :fast-safe) + (:translate c::fast-unary-ftruncate) + (:temporary (:sc signed-reg) temp) + (:note _N"inline ftruncate") + (:generator 2 + (inst cvttss2si temp x) + (inst cvtsi2ss r temp))) + +(define-vop (fast-unary-ftruncate/double-float) + (:args (x :scs (double-reg) :target r)) + (:arg-types double-float) + (:results (r :scs (double-reg))) + (:result-types double-float) + (:policy :fast-safe) + (:translate c::fast-unary-ftruncate) + (:temporary (:sc signed-reg) temp) + (:note _N"inline ftruncate") + (:generator 2 + (inst cvttsd2si temp x) + (inst cvtsi2sd r temp))) + (define-vop (make-single-float) (:args (bits :scs (signed-reg) :target res :load-if (not (or (and (sc-is bits signed-stack) @@ -1159,6 +1185,34 @@ (loadw lo-bits float vm:double-float-value-slot vm:other-pointer-type))))) +(define-vop (double-float-bits) + (:args (float :scs (double-reg descriptor-reg) + :load-if (not (sc-is float double-stack)))) + (:results (hi-bits :scs (signed-reg)) + (lo-bits :scs (unsigned-reg))) + (:arg-types double-float) + (:result-types signed-num unsigned-num) + (:temporary (:sc double-stack) temp) + (:translate kernel::double-float-bits) + (:policy :fast-safe) + (:vop-var vop) + (:generator 5 + (sc-case float + (double-reg + (let ((where (make-ea :dword :base ebp-tn + :disp (- (* (+ 2 (tn-offset temp)) + word-bytes))))) + (inst movsd where float)) + (loadw hi-bits ebp-tn (- (+ 1 (tn-offset temp)))) + (loadw lo-bits ebp-tn (- (+ 2 (tn-offset temp))))) + (double-stack + (loadw hi-bits ebp-tn (- (+ 1 (tn-offset float)))) + (loadw lo-bits ebp-tn (- (+ 2 (tn-offset float))))) + (descriptor-reg + (loadw hi-bits float (1+ double-float-value-slot) + vm:other-pointer-type) + (loadw lo-bits float vm:double-float-value-slot + vm:other-pointer-type)))))  ;;;; Float mode hackery: ----------------------------------------------------------------------- Summary of changes: src/code/kernel.lisp | 4 +-- src/compiler/float-tran.lisp | 24 +++++++++-------- src/compiler/x86/float-sse2.lisp | 54 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 69 insertions(+), 13 deletions(-) hooks/post-receive -- CMU Common Lisp