1.0.9.45: cleaner & thread-safe pv-table interning
[sbcl.git] / src / compiler / x86 / move.lisp
index 6d1ceb5..020f218 100644 (file)
 (define-move-fun (load-immediate 1) (vop x y)
   ((immediate)
    (any-reg descriptor-reg))
-  (let ((val (tn-value x)))
-    (etypecase val
-      (integer
-       (if (zerop val)
-           (inst xor y y)
-         (inst mov y (fixnumize val))))
-      (symbol
-       (load-symbol y val))
-      (character
-       (inst mov y (logior (ash (char-code val) n-widetag-bits)
-                           character-widetag))))))
+  (let ((val (encode-value-if-immediate x)))
+    (if (zerop val)
+        (inst xor y y)
+        (inst mov y val))))
 
 (define-move-fun (load-number 1) (vop x y)
   ((immediate) (signed-reg unsigned-reg))
   (:generator 0
     (if (and (sc-is x immediate)
              (sc-is y any-reg descriptor-reg control-stack))
-        (let ((val (tn-value x)))
-          (etypecase val
-            (integer
-             (if (and (zerop val) (sc-is y any-reg descriptor-reg))
-                 (inst xor y y)
-               (inst mov y (fixnumize val))))
-            (symbol
-             (inst mov y (+ nil-value (static-symbol-offset val))))
-            (character
-             (inst mov y (logior (ash (char-code val) n-widetag-bits)
-                                 character-widetag)))))
+        (let ((val (encode-value-if-immediate x)))
+          (if (and (zerop val) (sc-is y any-reg descriptor-reg))
+              (inst xor y y)
+              (inst mov y val)))
       (move y x))))
 
 (define-move-vop move :move
     (sc-case y
       ((any-reg descriptor-reg)
        (if (sc-is x immediate)
-           (let ((val (tn-value x)))
-             (etypecase val
-              (integer
-               (if (zerop val)
-                   (inst xor y y)
-                 (inst mov y (fixnumize val))))
-              (symbol
-               (load-symbol y val))
-              (character
-               (inst mov y (logior (ash (char-code val) n-widetag-bits)
-                                   character-widetag)))))
+           (let ((val (encode-value-if-immediate x)))
+             (if (zerop val)
+                 (inst xor y y)
+                 (inst mov y val)))
          (move y x)))
       ((control-stack)
        (let ((frame-offset (if (= (tn-offset fp) esp-offset)
                                (tn-offset y)
                                ;; Lisp stack
                                (frame-word-offset (tn-offset y)))))
-         (if (sc-is x immediate)
-             (let ((val (tn-value x)))
-               (etypecase val
-                 (integer
-                  (storew (fixnumize val) fp frame-offset))
-                 (symbol
-                  (storew (+ nil-value (static-symbol-offset val))
-                          fp frame-offset))
-                 (character
-                  (storew (logior (ash (char-code val) n-widetag-bits)
-                                  character-widetag)
-                          fp frame-offset))))
-             (storew x fp frame-offset)))))))
+         (storew (encode-value-if-immediate x) fp frame-offset))))))
 
 (define-move-vop move-arg :move-arg
   (any-reg descriptor-reg)