X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fmove.lisp;h=f10a953a9da4147c2d62354b9ccd886f4e1e487a;hb=3d544b84f2b7ecd617d220145a775079df6c7919;hp=4f37f5a36fb436db6ee778ab3e7e520a1b58587a;hpb=c6538bf61955a67d0145aa3e6c937f6dd03f9e51;p=sbcl.git diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp index 4f37f5a..f10a953 100644 --- a/src/compiler/x86-64/move.lisp +++ b/src/compiler/x86-64/move.lisp @@ -103,9 +103,7 @@ (let ((val (tn-value x))) (etypecase val (integer - (if (and (zerop val) (sc-is y any-reg descriptor-reg)) - (zeroize y) - (move-immediate y (fixnumize val) temp))) + (move-immediate y (fixnumize val) temp)) (symbol (inst mov y (+ nil-value (static-symbol-offset val)))) (character @@ -127,9 +125,11 @@ ;; If target is a register, we can just mov it there directly ((and (tn-p target) (sc-is target signed-reg unsigned-reg descriptor-reg any-reg)) - (inst mov target val)) + (if (zerop val) + (zeroize target) + (inst mov target val))) ;; Likewise if the value is small enough. - ((typep val '(signed-byte 31)) + ((typep val '(signed-byte 32)) (inst mov target val)) ;; Otherwise go through the temporary register (tmp-tn @@ -159,10 +159,8 @@ (etypecase val ((integer 0 0) (zeroize y)) - ((or (signed-byte 29) (unsigned-byte 29)) - (inst mov y (fixnumize val))) (integer - (move-immediate y (fixnumize val))) + (inst mov y (fixnumize val))) (symbol (load-symbol y val)) (character @@ -187,19 +185,19 @@ ;; Lisp stack (etypecase val (integer - (storew (fixnumize val) fp (- (1+ (tn-offset y))))) + (storew (fixnumize val) fp (frame-word-offset (tn-offset y)))) (symbol (storew (+ nil-value (static-symbol-offset val)) - fp (- (1+ (tn-offset y))))) + fp (frame-word-offset (tn-offset y)))) (character (storew (logior (ash (char-code val) n-widetag-bits) character-widetag) - fp (- (1+ (tn-offset y)))))))) + fp (frame-word-offset (tn-offset y))))))) (if (= (tn-offset fp) esp-offset) ;; C-call (storew x fp (tn-offset y)) ;; Lisp stack - (storew x fp (- (1+ (tn-offset y)))))))))) + (storew x fp (frame-word-offset (tn-offset y))))))))) (define-move-vop move-arg :move-arg (any-reg descriptor-reg) @@ -238,7 +236,7 @@ (:note "fixnum untagging") (:generator 1 (move y x) - (inst sar y (1- n-lowtag-bits)))) + (inst sar y n-fixnum-tag-bits))) (define-move-vop move-to-word/fixnum :move (any-reg descriptor-reg) (signed-reg unsigned-reg)) @@ -248,32 +246,60 @@ (:results (y :scs (signed-reg unsigned-reg))) (:note "constant load") (:generator 1 - (inst mov y (tn-value x)))) + (cond ((sb!c::tn-leaf x) + (inst mov y (tn-value x))) + (t + (inst mov y x) + (inst sar y n-fixnum-tag-bits))))) (define-move-vop move-to-word-c :move (constant) (signed-reg unsigned-reg)) ;;; Arg is a fixnum or bignum, figure out which and load if necessary. +#-#.(cl:if (cl:= sb!vm:n-fixnum-tag-bits 1) '(:and) '(:or)) (define-vop (move-to-word/integer) - (:args (x :scs (descriptor-reg) :target eax)) + (:args (x :scs (descriptor-reg) :target rax)) (:results (y :scs (signed-reg unsigned-reg))) (:note "integer to untagged word coercion") - (:temporary (:sc unsigned-reg :offset eax-offset - :from (:argument 0) :to (:result 0) :target y) eax) + ;; I'm not convinced that increasing the demand for rAX is + ;; better than adding 1 byte to some instruction encodings. + ;; I'll leave it alone though. + (:temporary (:sc unsigned-reg :offset rax-offset + :from (:argument 0) :to (:result 0) :target y) rax) (:generator 4 - (move eax x) - (inst test al-tn 7) ; a symbolic constant for this - (inst jmp :z FIXNUM) ; would be nice - (loadw y eax bignum-digits-offset other-pointer-lowtag) + (move rax x) + (inst test al-tn fixnum-tag-mask) + (inst jmp :z FIXNUM) + (loadw y rax bignum-digits-offset other-pointer-lowtag) (inst jmp DONE) FIXNUM - (inst sar eax (1- n-lowtag-bits)) - (move y eax) + (inst sar rax n-fixnum-tag-bits) + (move y rax) DONE)) + +#+#.(cl:if (cl:= sb!vm:n-fixnum-tag-bits 1) '(:and) '(:or)) +(define-vop (move-to-word/integer) + (:args (x :scs (descriptor-reg) :target y)) + (:results (y :scs (signed-reg unsigned-reg))) + (:note "integer to untagged word coercion") + (:temporary (:sc unsigned-reg) backup) + (:generator 4 + (move y x) + (if (location= x y) + ;; It would be great if a principled way existed to advise GC of + ;; algebraic transforms such as 2*R being a conservative root. + ;; Until that is possible, emit straightforward code that uses + ;; a copy of the potential reference. + (move backup x) + (setf backup x)) + (inst sar y 1) ; optimistically assume it's a fixnum + (inst jmp :nc DONE) ; no carry implies tag was 0 + (loadw y backup bignum-digits-offset other-pointer-lowtag) + DONE)) + (define-move-vop move-to-word/integer :move (descriptor-reg) (signed-reg unsigned-reg)) - ;;; Result is a fixnum, so we can just shift. We need the result type ;;; restriction because of the control-stack ambiguity noted above. (define-vop (move-from-word/fixnum) @@ -286,12 +312,14 @@ (:generator 1 (cond ((and (sc-is x signed-reg unsigned-reg) (not (location= x y))) - ;; Uses 7 bytes, but faster on the Pentium - (inst lea y (make-ea :qword :index x :scale 8))) + (if (= n-fixnum-tag-bits 1) + (inst lea y (make-ea :qword :base x :index x)) + (inst lea y (make-ea :qword :index x + :scale (ash 1 n-fixnum-tag-bits))))) (t ;; Uses: If x is a reg 2 + 3; if x = y uses only 3 bytes (move y x) - (inst shl y (1- n-lowtag-bits)))))) + (inst shl y n-fixnum-tag-bits))))) (define-move-vop move-from-word/fixnum :move (signed-reg unsigned-reg) (any-reg descriptor-reg)) @@ -299,35 +327,43 @@ ;;; as the case may be. Fixnum case inline, bignum case in an assembly ;;; routine. (define-vop (move-from-signed) - (:args (x :scs (signed-reg unsigned-reg) :to :result)) - (:results (y :scs (any-reg descriptor-reg) :from :argument)) + (:args (x :scs (signed-reg unsigned-reg) :to :result . #.(and (= 1 n-fixnum-tag-bits) + '(:target y)))) + (:results (y :scs (any-reg descriptor-reg) . #.(and (> n-fixnum-tag-bits 1) + '(:from :argument)))) (:note "signed word to integer coercion") ;; Worst case cost to make sure people know they may be number consing. (:generator 20 - (aver (not (location= x y))) - (let ((done (gen-label))) - (inst imul y x #.(ash 1 n-fixnum-tag-bits)) - (inst jmp :no done) - (inst mov y x) - (inst lea temp-reg-tn - (make-ea :qword :disp - (make-fixup (ecase (tn-offset y) - (#.rax-offset 'alloc-signed-bignum-in-rax) - (#.rcx-offset 'alloc-signed-bignum-in-rcx) - (#.rdx-offset 'alloc-signed-bignum-in-rdx) - (#.rbx-offset 'alloc-signed-bignum-in-rbx) - (#.rsi-offset 'alloc-signed-bignum-in-rsi) - (#.rdi-offset 'alloc-signed-bignum-in-rdi) - (#.r8-offset 'alloc-signed-bignum-in-r8) - (#.r9-offset 'alloc-signed-bignum-in-r9) - (#.r10-offset 'alloc-signed-bignum-in-r10) - (#.r12-offset 'alloc-signed-bignum-in-r12) - (#.r13-offset 'alloc-signed-bignum-in-r13) - (#.r14-offset 'alloc-signed-bignum-in-r14) - (#.r15-offset 'alloc-signed-bignum-in-r15)) - :assembly-routine))) - (inst call temp-reg-tn) - (emit-label done)))) + (cond ((= 1 n-fixnum-tag-bits) + (move y x) + (inst shl y 1) + (inst jmp :no DONE) + (if (location= y x) + (inst rcr y 1) ; we're about to cons a bignum. this RCR is noise + (inst mov y x))) + (t + (aver (not (location= x y))) + (inst imul y x #.(ash 1 n-fixnum-tag-bits)) + (inst jmp :no DONE) + (inst mov y x))) + (inst mov temp-reg-tn + (make-fixup (ecase (tn-offset y) + (#.rax-offset 'alloc-signed-bignum-in-rax) + (#.rcx-offset 'alloc-signed-bignum-in-rcx) + (#.rdx-offset 'alloc-signed-bignum-in-rdx) + (#.rbx-offset 'alloc-signed-bignum-in-rbx) + (#.rsi-offset 'alloc-signed-bignum-in-rsi) + (#.rdi-offset 'alloc-signed-bignum-in-rdi) + (#.r8-offset 'alloc-signed-bignum-in-r8) + (#.r9-offset 'alloc-signed-bignum-in-r9) + (#.r10-offset 'alloc-signed-bignum-in-r10) + (#.r12-offset 'alloc-signed-bignum-in-r12) + (#.r13-offset 'alloc-signed-bignum-in-r13) + (#.r14-offset 'alloc-signed-bignum-in-r14) + (#.r15-offset 'alloc-signed-bignum-in-r15)) + :assembly-routine)) + (inst call temp-reg-tn) + DONE)) (define-move-vop move-from-signed :move (signed-reg) (descriptor-reg)) @@ -342,34 +378,38 @@ (:generator 20 (aver (not (location= x y))) (let ((done (gen-label))) - (inst mov y #.(ash lowtag-mask (- n-word-bits n-fixnum-tag-bits 1))) + (inst mov y #.(ash (1- (ash 1 (1+ n-fixnum-tag-bits))) + n-positive-fixnum-bits)) ;; The assembly routines test the sign flag from this one, so if ;; you change stuff here, make sure the sign flag doesn't get ;; overwritten before the CALL! (inst test x y) - ;; Faster but bigger then SHL Y 4. The cost of doing this - ;; speculatively should be noise compared to bignum consing if - ;; that is needed and saves one branch. - (inst lea y (make-ea :qword :index x :scale 8)) + ;; Using LEA is faster but bigger than MOV+SHL; it also doesn't + ;; twiddle the sign flag. The cost of doing this speculatively + ;; should be noise compared to bignum consing if that is needed + ;; and saves one branch. + (if (= n-fixnum-tag-bits 1) + (inst lea y (make-ea :qword :base x :index x)) + (inst lea y (make-ea :qword :index x + :scale (ash 1 n-fixnum-tag-bits)))) (inst jmp :z done) (inst mov y x) - (inst lea temp-reg-tn - (make-ea :qword :disp - (make-fixup (ecase (tn-offset y) - (#.rax-offset 'alloc-unsigned-bignum-in-rax) - (#.rcx-offset 'alloc-unsigned-bignum-in-rcx) - (#.rdx-offset 'alloc-unsigned-bignum-in-rdx) - (#.rbx-offset 'alloc-unsigned-bignum-in-rbx) - (#.rsi-offset 'alloc-unsigned-bignum-in-rsi) - (#.rdi-offset 'alloc-unsigned-bignum-in-rdi) - (#.r8-offset 'alloc-unsigned-bignum-in-r8) - (#.r9-offset 'alloc-unsigned-bignum-in-r9) - (#.r10-offset 'alloc-unsigned-bignum-in-r10) - (#.r12-offset 'alloc-unsigned-bignum-in-r12) - (#.r13-offset 'alloc-unsigned-bignum-in-r13) - (#.r14-offset 'alloc-unsigned-bignum-in-r14) - (#.r15-offset 'alloc-unsigned-bignum-in-r15)) - :assembly-routine))) + (inst mov temp-reg-tn + (make-fixup (ecase (tn-offset y) + (#.rax-offset 'alloc-unsigned-bignum-in-rax) + (#.rcx-offset 'alloc-unsigned-bignum-in-rcx) + (#.rdx-offset 'alloc-unsigned-bignum-in-rdx) + (#.rbx-offset 'alloc-unsigned-bignum-in-rbx) + (#.rsi-offset 'alloc-unsigned-bignum-in-rsi) + (#.rdi-offset 'alloc-unsigned-bignum-in-rdi) + (#.r8-offset 'alloc-unsigned-bignum-in-r8) + (#.r9-offset 'alloc-unsigned-bignum-in-r9) + (#.r10-offset 'alloc-unsigned-bignum-in-r10) + (#.r12-offset 'alloc-unsigned-bignum-in-r12) + (#.r13-offset 'alloc-unsigned-bignum-in-r13) + (#.r14-offset 'alloc-unsigned-bignum-in-r14) + (#.r15-offset 'alloc-unsigned-bignum-in-r15)) + :assembly-routine)) (inst call temp-reg-tn) (emit-label done)))) (define-move-vop move-from-unsigned :move @@ -405,7 +445,7 @@ ((signed-stack unsigned-stack) (if (= (tn-offset fp) esp-offset) (storew x fp (tn-offset y)) ; c-call - (storew x fp (- (1+ (tn-offset y))))))))) + (storew x fp (frame-word-offset (tn-offset y)))))))) (define-move-vop move-word-arg :move-arg (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))