1.0.7.26: asymptotically faster FIND-SLOT-DEFINITION

[sbcl.git] / src / compiler / x86-64 / move.lisp

diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp
index cc24df4..1a5279c 100644 (file)
--- a/src/compiler/x86-64/move.lisp
+++ b/src/compiler/x86-64/move.lisp
@@ -1,4 +1,4 @@
-;;;; the x86 VM definition of operand loading/saving and the MOVE vop
+;;;; the x86-64 VM definition of operand loading/saving and the MOVE vop
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -11,6 +11,30 @@
 
 (in-package "SB!VM")
 
+(defun make-byte-tn (tn)
+  (aver (sc-is tn any-reg descriptor-reg unsigned-reg signed-reg))
+  (make-random-tn :kind :normal
+                  :sc (sc-or-lose 'byte-reg)
+                  :offset (tn-offset tn)))
+
+(defun make-dword-tn (tn)
+  (aver (sc-is tn any-reg descriptor-reg character-reg
+               unsigned-reg signed-reg))
+  (make-random-tn :kind :normal
+                  :sc (sc-or-lose 'dword-reg)
+                  :offset (tn-offset tn)))
+
+(defun zeroize (tn)
+  (let ((offset (tn-offset tn)))
+    ;; Using the 32-bit instruction accomplishes the same thing and is
+    ;; one byte shorter.
+    (if (<= offset edi-offset)
+        (let ((tn (make-random-tn :kind :normal
+                                  :sc (sc-or-lose 'dword-reg)
+                                  :offset offset)))
+          (inst xor tn tn))
+        (inst xor tn tn))))
+
 (define-move-fun (load-immediate 1) (vop x y)
   ((immediate)
    (any-reg descriptor-reg))
@@ -18,7 +42,7 @@
     (etypecase val
       (integer
        (if (zerop val)
-           (inst xor y y)
+           (zeroize y)
          (inst mov y (fixnumize val))))
       (symbol
        (load-symbol y val))
@@ -28,7 +52,10 @@
 
 (define-move-fun (load-number 1) (vop x y)
   ((immediate) (signed-reg unsigned-reg))
-  (inst mov y (tn-value x)))
+  (let ((val (tn-value x)))
+    (if (zerop val)
+        (zeroize y)
+        (inst mov y val))))
 
 (define-move-fun (load-character 1) (vop x y)
   ((immediate) (character-reg))
@@ -77,7 +104,7 @@
           (etypecase val
             (integer
              (if (and (zerop val) (sc-is y any-reg descriptor-reg))
-                 (inst xor y y)
+                 (zeroize y)
                  (move-immediate y (fixnumize val) temp)))
             (symbol
              (inst mov y (+ nil-value (static-symbol-offset val))))
@@ -131,7 +158,7 @@
            (let ((val (tn-value x)))
              (etypecase val
                ((integer 0 0)
-                (inst xor y y))
+                (zeroize y))
                ((or (signed-byte 29) (unsigned-byte 29))
                 (inst mov y (fixnumize val)))
                (integer
@@ -279,7 +306,6 @@
      (aver (not (location= x y)))
      (let ((bignum (gen-label))
            (done (gen-label)))
-       (inst mov y x)
        ;; We can't do the overflow check with SHL Y, 3, since the
        ;; state of the overflow flag is only reliably set when
        ;; shifting by 1. There used to be code here for doing "shift
@@ -288,7 +314,7 @@
        ;; we can just do a straight multiply instead of trying to
        ;; optimize it to a shift. This is both faster and smaller.
        ;; -- JES, 2006-07-08
-       (inst imul y 8)
+       (inst imul y x (ash 1 n-fixnum-tag-bits))
        (inst jmp :o bignum)
        (emit-label done)