1.0.12.28: small PCL cache cleanups
[sbcl.git] / src / compiler / x86 / move.lisp
index 31903d5..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)
-       (if (sc-is x immediate)
-           (let ((val (tn-value x)))
-             (if (= (tn-offset fp) esp-offset)
-                 ;; C-call
-                 (etypecase val
-                   (integer
-                    (storew (fixnumize val) fp (tn-offset y)))
-                   (symbol
-                    (storew (+ nil-value (static-symbol-offset val))
-                            fp (tn-offset y)))
-                   (character
-                    (storew (logior (ash (char-code val) n-widetag-bits)
-                                    character-widetag)
-                            fp (tn-offset y))))
-               ;; Lisp stack
-               (etypecase val
-                 (integer
-                  (storew (fixnumize val) fp (- (1+ (tn-offset y)))))
-                 (symbol
-                  (storew (+ nil-value (static-symbol-offset val))
-                          fp (- (1+ (tn-offset y)))))
-                 (character
-                  (storew (logior (ash (char-code val) n-widetag-bits)
-                                  character-widetag)
-                          fp (- (1+ (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))))))))))
+       (let ((frame-offset (if (= (tn-offset fp) esp-offset)
+                               ;; C-call
+                               (tn-offset y)
+                               ;; Lisp stack
+                               (frame-word-offset (tn-offset y)))))
+         (storew (encode-value-if-immediate x) fp frame-offset))))))
 
 (define-move-vop move-arg :move-arg
   (any-reg descriptor-reg)
       ((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))