Commit 07e2d61f authored by Raymond Toy's avatar Raymond Toy
Browse files

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.
parent 622b5df4
...@@ -180,10 +180,10 @@ ...@@ -180,10 +180,10 @@
#+long-float #+long-float
(defun long-float-low-bits (x) (long-float-low-bits x)) (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)) (defun double-float-bits (x) (double-float-bits x))
#-(or sparc ppc) #-(or sparc ppc (and x86 sse2))
(defun double-float-bits (x) (defun double-float-bits (x)
(values (double-float-high-bits x) (double-float-low-bits x))) (values (double-float-high-bits x) (double-float-low-bits x)))
......
...@@ -192,12 +192,12 @@ ...@@ -192,12 +192,12 @@
'(let ((res (%unary-ftruncate (/ x y)))) '(let ((res (%unary-ftruncate (/ x y))))
(values res (- x (* y res))))) (values res (- x (* y res)))))
#+sparc #+(or sparc (and x86 sse2))
(defknown fast-unary-ftruncate ((or single-float double-float)) (defknown fast-unary-ftruncate ((or single-float double-float))
(or single-float double-float) (or single-float double-float)
(movable foldable flushable)) (movable foldable flushable))
#+sparc #+(or sparc (and x86 sse2))
(defoptimizer (fast-unary-ftruncate derive-type) ((f)) (defoptimizer (fast-unary-ftruncate derive-type) ((f))
(one-arg-derive-type f (one-arg-derive-type f
#'(lambda (n) #'(lambda (n)
...@@ -224,14 +224,16 @@ ...@@ -224,14 +224,16 @@
(if (and (numberp lo) (numberp hi) (if (and (numberp lo) (numberp hi)
(< limit-lo lo) (< limit-lo lo)
(< hi limit-hi)) (< hi limit-hi))
#-sparc '(let ((result (coerce (%unary-truncate x) ',ftype))) #-(or sparc (and x86 sse2))
(if (zerop result) '(let ((result (coerce (%unary-truncate x) ',ftype)))
(* result x) (if (zerop result)
result)) (* result x)
#+sparc '(let ((result (fast-unary-ftruncate x))) result))
(if (zerop result) #+(or sparc (and x86 sse2))
(* result x) '(let ((result (fast-unary-ftruncate x)))
result)) (if (zerop result)
(* result x)
result))
'(,func x)))))) '(,func x))))))
(frob single-float %unary-ftruncate/single-float) (frob single-float %unary-ftruncate/single-float)
(frob double-float %unary-ftruncate/double-float)) (frob double-float %unary-ftruncate/double-float))
...@@ -355,7 +357,7 @@ ...@@ -355,7 +357,7 @@
(defknown double-float-low-bits (double-float) (unsigned-byte 32) (defknown double-float-low-bits (double-float) (unsigned-byte 32)
(movable foldable flushable)) (movable foldable flushable))
#+(or sparc ppc) #+(or sparc ppc (and x86 sse2))
(defknown double-float-bits (double-float) (defknown double-float-bits (double-float)
(values (signed-byte 32) (unsigned-byte 32)) (values (signed-byte 32) (unsigned-byte 32))
(movable foldable flushable)) (movable foldable flushable))
......
...@@ -1038,6 +1038,32 @@ ...@@ -1038,6 +1038,32 @@
(frob %unary-round cvtss2si single-reg single-float t) (frob %unary-round cvtss2si single-reg single-float t)
(frob %unary-round cvtsd2si double-reg double-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) (define-vop (make-single-float)
(:args (bits :scs (signed-reg) :target res (:args (bits :scs (signed-reg) :target res
:load-if (not (or (and (sc-is bits signed-stack) :load-if (not (or (and (sc-is bits signed-stack)
...@@ -1159,6 +1185,34 @@ ...@@ -1159,6 +1185,34 @@
(loadw lo-bits float vm:double-float-value-slot (loadw lo-bits float vm:double-float-value-slot
vm:other-pointer-type))))) 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: ;;;; Float mode hackery:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment