X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Ffloat.lisp;h=23eef993996be6c3fbb3e8d5644f22e276ddb507;hb=d25e3478acccec70402ff32554669a982be8e281;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..23eef99 100644 --- a/src/compiler/x86-64/float.lisp +++ b/src/compiler/x86-64/float.lisp @@ -32,8 +32,7 @@ (declare (ignore kind)) `(make-ea :qword :base rbp-tn - :disp (- (* (+ (tn-offset ,tn) 1) - n-word-bytes))))) + :disp (frame-byte-offset (tn-offset ,tn))))) (defun ea-for-sf-stack (tn) (ea-for-xf-stack tn :single)) (defun ea-for-df-stack (tn) @@ -44,9 +43,14 @@ (declare (ignore kind)) `(make-ea :qword :base ,base - :disp (- (* (+ (tn-offset ,tn) - (* 1 (ecase ,slot (:real 1) (:imag 2)))) - n-word-bytes))))) + :disp (frame-byte-offset + (+ (tn-offset ,tn) + (cond ((= (tn-offset ,base) rsp-offset) + sp->fp-offset) + ((= (tn-offset ,base) rbp-offset) + 0) + (t (error "Unexpected offset."))) + (ecase ,slot (:real 0) (:imag 1))))))) (defun ea-for-csf-real-stack (tn &optional (base rbp-tn)) (ea-for-cxf-stack tn :single :real base)) (defun ea-for-csf-imag-stack (tn &optional (base rbp-tn)) @@ -64,8 +68,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,11 +330,7 @@ (:double '((inst movsd ea x))))) (let ((ea (make-ea :dword :base fp - :disp (- (* (+ (tn-offset y) - ,(case format - (:single 1) - (:double 2) )) - n-word-bytes))))) + :disp (frame-byte-offset (tn-offset y))))) ,@(ecase format (:single '((inst movss ea x))) (:double '((inst movsd ea x)))))))))) @@ -439,7 +441,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) @@ -487,8 +501,6 @@ ;;;; comparison (define-vop (float-compare) - (:conditional) - (:info target not-p) (:policy :fast-safe) (:vop-var vop) (:save-p :compute-only) @@ -500,75 +512,59 @@ (define-vop (single-float-compare float-compare) (:args (x :scs (single-reg)) (y :scs (single-reg))) - (:conditional) (:arg-types single-float single-float)) (define-vop (double-float-compare float-compare) (:args (x :scs (double-reg)) (y :scs (double-reg))) - (:conditional) (:arg-types double-float double-float)) (define-vop (=/single-float single-float-compare) (:translate =) - (:info target not-p) + (:info) + (:conditional not :p :ne) (:vop-var vop) (:generator 3 (note-this-location vop :internal-error) (inst comiss x y) ;; if PF&CF, there was a NaN involved => not equal ;; otherwise, ZF => equal - (cond (not-p - (inst jmp :p target) - (inst jmp :ne target)) - (t - (let ((not-lab (gen-label))) - (inst jmp :p not-lab) - (inst jmp :e target) - (emit-label not-lab)))))) + )) (define-vop (=/double-float double-float-compare) (:translate =) - (:info target not-p) + (:info) + (:conditional not :p :ne) (:vop-var vop) (:generator 3 (note-this-location vop :internal-error) - (inst comisd x y) - (cond (not-p - (inst jmp :p target) - (inst jmp :ne target)) - (t - (let ((not-lab (gen-label))) - (inst jmp :p not-lab) - (inst jmp :e target) - (emit-label not-lab)))))) - -;; XXX all of these probably have bad NaN behaviour + (inst comisd x y))) + (define-vop (double-float double-float-compare) (:translate >) - (:info target not-p) - (:generator 2 - (inst comisd x y) - (inst jmp (if not-p :na :a) target))) + (:info) + (:conditional not :p :na) + (:generator 3 + (inst comisd x y))) (define-vop (>single-float single-float-compare) (:translate >) - (:info target not-p) - (:generator 2 - (inst comiss x y) - (inst jmp (if not-p :na :a) target))) + (:info) + (:conditional not :p :na) + (:generator 3 + (inst comiss x y))) @@ -735,7 +731,7 @@ (inst movsd temp float) (move hi-bits temp)) (double-stack - (loadw hi-bits ebp-tn (- (1+ (tn-offset float))))) + (loadw hi-bits ebp-tn (frame-word-offset (tn-offset float)))) (descriptor-reg (loadw hi-bits float double-float-value-slot other-pointer-lowtag))) @@ -757,7 +753,7 @@ (inst movsd temp float) (move lo-bits temp)) (double-stack - (loadw lo-bits ebp-tn (- (1+ (tn-offset float))))) + (loadw lo-bits ebp-tn (frame-word-offset (tn-offset float)))) (descriptor-reg (loadw lo-bits float double-float-value-slot other-pointer-lowtag))) @@ -789,7 +785,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 +810,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)