1.0.32.29: Add build flag :sb-xref-for-internals.
[sbcl.git] / src / compiler / x86-64 / move.lisp
index 1921dfa..b5c628b 100644 (file)
                ;; 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)
   (:vop-var vop)
   (:save-p :compute-only)
   (:generator 666
-    (error-call vop object-not-type-error x type)))
+    (error-call vop 'object-not-type-error x type)))
 \f
 ;;;; moves and coercions
 
   (: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))
 
       ((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))