X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Ffloat.lisp;h=63ae04004b73aa9202f219579e3c8f74f6b040df;hb=085501b44cc1cbdd9e260139d30b383372ddd1b8;hp=310d92a89ec27017f3de156f9da711ed54624248;hpb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;p=sbcl.git diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp index 310d92a..63ae040 100644 --- a/src/compiler/x86-64/float.lisp +++ b/src/compiler/x86-64/float.lisp @@ -64,8 +64,10 @@ (define-move-fun (load-fp-zero 1) (vop x y) ((fp-single-zero) (single-reg) (fp-double-zero) (double-reg)) - (identity x) ; KLUDGE: IDENTITY as IGNORABLE... - (inst movq y fp-double-zero-tn)) + (identity x) + (sc-case y + (single-reg (inst xorps y y)) + (double-reg (inst xorpd y y)))) (define-move-fun (load-single 2) (vop x y) ((single-stack) (single-reg)) @@ -324,10 +326,7 @@ (:double '((inst movsd ea x))))) (let ((ea (make-ea :dword :base fp - :disp (- (* (+ (tn-offset y) - ,(case format - (:single 1) - (:double 2) )) + :disp (- (* (1+ (tn-offset y)) n-word-bytes))))) ,@(ecase format (:single '((inst movss ea x))) @@ -439,7 +438,19 @@ (frob * mulss */single-float 4 mulsd */double-float 5 t) (frob / divss //single-float 12 divsd //double-float 19 nil)) - +(define-vop (fsqrt) + (:args (x :scs (double-reg))) + (:results (y :scs (double-reg))) + (:translate %sqrt) + (:policy :fast-safe) + (:arg-types double-float) + (:result-types double-float) + (:note "inline float arithmetic") + (:vop-var vop) + (:save-p :compute-only) + (:generator 1 + (note-this-location vop :internal-error) + (inst sqrtsd y x))) (macrolet ((frob ((name translate sc type) &body body) `(define-vop (,name) @@ -789,7 +800,8 @@ (unless (location= imag r-imag) (inst movss r-imag imag)))) (complex-single-stack - (inst movss (ea-for-csf-real-stack r) real) + (unless (location= real r) + (inst movss (ea-for-csf-real-stack r) real)) (inst movss (ea-for-csf-imag-stack r) imag))))) (define-vop (make-complex-double-float) @@ -813,7 +825,8 @@ (unless (location= imag r-imag) (inst movsd r-imag imag)))) (complex-double-stack - (inst movsd (ea-for-cdf-real-stack r) real) + (unless (location= real r) + (inst movsd (ea-for-cdf-real-stack r) real)) (inst movsd (ea-for-cdf-imag-stack r) imag))))) (define-vop (complex-float-value)