X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Ffloat.lisp;h=601dabd8cafe1858b277b54d1c98962a47fbb6c0;hb=33a45339444f8418c8c537c43d59fc3d5ea3098b;hp=b0d1b771c6b9262a187e95336ac3da7261474623;hpb=c4b30c86e3dd1d1cc70c572a6cfffe8b84e9c34a;p=sbcl.git diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp index b0d1b77..601dabd 100644 --- a/src/compiler/x86-64/float.lisp +++ b/src/compiler/x86-64/float.lisp @@ -51,9 +51,7 @@ (+ (tn-offset ,tn) (cond ((= (tn-offset ,base) rsp-offset) sp->fp-offset) - ((= (tn-offset ,base) rbp-offset) - 0) - (t (error "Unexpected offset."))) + (t 0)) (ecase ,kind (:single (ecase ,slot @@ -191,17 +189,39 @@ (double-reg) (descriptor-reg)) ;;; Move from a descriptor to a float register. -(define-vop (move-to-single) +(define-vop (move-to-single-reg) + (:args (x :scs (descriptor-reg) :target tmp + :load-if (not (sc-is x control-stack)))) + (:temporary (:sc unsigned-reg :from :argument :to :result) tmp) + (:results (y :scs (single-reg))) + (:note "pointer to float coercion") + (:generator 2 + (sc-case x + (descriptor-reg + (move tmp x) + (inst shr tmp 32) + (inst movd y tmp)) + (control-stack + ;; When the single-float descriptor is in memory, the untagging + ;; is done in the target XMM register. This is faster than going + ;; through a general-purpose register and the code is smaller. + (inst movq y x) + (inst shufps y y #4r3331))))) +(define-move-vop move-to-single-reg :move (descriptor-reg) (single-reg)) + +;;; Move from a descriptor to a float stack. +(define-vop (move-to-single-stack) (:args (x :scs (descriptor-reg) :target tmp)) - (:temporary (:sc unsigned-reg) tmp) - (:results (y :scs (single-reg))) + (:temporary (:sc unsigned-reg :from :argument :to :result) tmp) + (:results (y :scs (single-stack))) (:note "pointer to float coercion") (:generator 2 (move tmp x) (inst shr tmp 32) - (inst movd y tmp))) - -(define-move-vop move-to-single :move (descriptor-reg) (single-reg)) + (let ((slot (make-ea :dword :base rbp-tn + :disp (frame-byte-offset (tn-offset y))))) + (inst mov slot (reg-in-size tmp :dword))))) +(define-move-vop move-to-single-stack :move (descriptor-reg) (single-stack)) (define-vop (move-to-double) (:args (x :scs (descriptor-reg))) @@ -633,7 +653,7 @@ `(progn (move dup real) (inst unpcklps dup dup))) - ,single-inst movss movaps + ,single-inst movss movq single-reg fp-single-immediate single-float complex-single-reg fp-complex-single-immediate complex-single-float ,single-real-complex-name ,single-complex-real-name) @@ -772,6 +792,8 @@ (:vop-var vop) (:save-p :compute-only) (:generator 1 + (unless (location= x y) + (inst xorpd y y)) (note-this-location vop :internal-error) (inst sqrtsd y x))) @@ -1039,8 +1061,7 @@ (macrolet ((frob (name translate inst to-sc to-type) `(define-vop (,name) - (:args (x :scs (signed-stack signed-reg) :target temp)) - (:temporary (:sc signed-stack) temp) + (:args (x :scs (signed-stack signed-reg))) (:results (y :scs (,to-sc))) (:arg-types signed-num) (:result-types ,to-type) @@ -1050,20 +1071,17 @@ (:vop-var vop) (:save-p :compute-only) (:generator 5 - (sc-case x - (signed-reg - (inst mov temp x) - (note-this-location vop :internal-error) - (inst ,inst y temp)) - (signed-stack - (note-this-location vop :internal-error) - (inst ,inst y x))))))) + (sc-case y + (single-reg (inst xorps y y)) + (double-reg (inst xorpd y y))) + (note-this-location vop :internal-error) + (inst ,inst y x))))) (frob %single-float/signed %single-float cvtsi2ss single-reg single-float) (frob %double-float/signed %double-float cvtsi2sd double-reg double-float)) -(macrolet ((frob (name translate inst from-sc from-type to-sc to-type) +(macrolet ((frob (name translate inst from-scs from-type ea-func to-sc to-type) `(define-vop (,name) - (:args (x :scs (,from-sc) :target y)) + (:args (x :scs ,from-scs :target y)) (:results (y :scs (,to-sc))) (:arg-types ,from-type) (:result-types ,to-type) @@ -1073,19 +1091,29 @@ (:vop-var vop) (:save-p :compute-only) (:generator 2 + (unless (location= x y) + (sc-case y + (single-reg (inst xorps y y)) + (double-reg (inst xorpd y y)))) (note-this-location vop :internal-error) - (inst ,inst y x))))) - (frob %single-float/double-float %single-float cvtsd2ss double-reg - double-float single-reg single-float) + (inst ,inst y (sc-case x + (,(first from-scs) x) + (,(second from-scs) (,ea-func x)))) + ,(when (and (eq from-type 'double-float) ; if the input is wider + (eq to-type 'single-float)) ; than the output, clear + `(when (location= x y) ; noise in the high part + (inst shufps y y #4r3330))))))) + (frob %single-float/double-float %single-float cvtsd2ss + (double-reg double-stack) double-float ea-for-df-stack + single-reg single-float) (frob %double-float/single-float %double-float cvtss2sd - single-reg single-float double-reg double-float)) + (single-reg single-stack) single-float ea-for-sf-stack + double-reg double-float)) -(macrolet ((frob (trans inst from-sc from-type round-p) - (declare (ignore round-p)) +(macrolet ((frob (trans inst from-scs from-type ea-func) `(define-vop (,(symbolicate trans "/" from-type)) - (:args (x :scs (,from-sc))) - (:temporary (:sc any-reg) temp-reg) + (:args (x :scs ,from-scs)) (:results (y :scs (signed-reg))) (:arg-types ,from-type) (:result-types signed-num) @@ -1095,18 +1123,18 @@ (:vop-var vop) (:save-p :compute-only) (:generator 5 - (sc-case y - (signed-stack - (inst ,inst temp-reg x) - (move y temp-reg)) - (signed-reg - (inst ,inst y x) - )))))) - (frob %unary-truncate cvttss2si single-reg single-float nil) - (frob %unary-truncate cvttsd2si double-reg double-float nil) - - (frob %unary-round cvtss2si single-reg single-float t) - (frob %unary-round cvtsd2si double-reg double-float t)) + (inst ,inst y (sc-case x + (,(first from-scs) x) + (,(second from-scs) (,ea-func x)))))))) + (frob %unary-truncate/single-float cvttss2si + (single-reg single-stack) single-float ea-for-sf-stack) + (frob %unary-truncate/double-float cvttsd2si + (double-reg double-stack) double-float ea-for-df-stack) + + (frob %unary-round cvtss2si + (single-reg single-stack) single-float ea-for-sf-stack) + (frob %unary-round cvtsd2si + (double-reg double-stack) double-float ea-for-df-stack)) (define-vop (make-single-float) (:args (bits :scs (signed-reg) :target res