X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmove.lisp;h=20fb9610a919a7bb4ee187c22c8e7ac849266454;hb=50305b602c3953440af716137a56f50cd204375d;hp=5c6cab457590324895e0e0f534198509a2edc95b;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 5c6cab4..20fb961 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -11,9 +11,6 @@ (in-package "SB!VM") -(file-comment - "$Header$") - (define-move-function (load-immediate 1) (vop x y) ((immediate) (any-reg descriptor-reg)) @@ -26,8 +23,8 @@ (symbol (load-symbol y val)) (character - (inst mov y (logior (ash (char-code val) type-bits) - base-char-type)))))) + (inst mov y (logior (ash (char-code val) n-widetag-bits) + base-char-widetag)))))) (define-move-function (load-number 1) (vop x y) ((immediate) (signed-reg unsigned-reg)) @@ -82,10 +79,10 @@ (inst xor y y) (inst mov y (fixnumize val)))) (symbol - (inst mov y (+ *nil-value* (static-symbol-offset val)))) + (inst mov y (+ nil-value (static-symbol-offset val)))) (character - (inst mov y (logior (ash (char-code val) type-bits) - base-char-type))))) + (inst mov y (logior (ash (char-code val) n-widetag-bits) + base-char-widetag))))) (move y x)))) (define-move-vop move :move @@ -123,8 +120,8 @@ (symbol (load-symbol y val)) (character - (inst mov y (logior (ash (char-code val) type-bits) - base-char-type))))) + (inst mov y (logior (ash (char-code val) n-widetag-bits) + base-char-widetag))))) (move y x))) ((control-stack) (if (sc-is x immediate) @@ -135,22 +132,22 @@ (integer (storew (fixnumize val) fp (tn-offset y))) (symbol - (storew (+ *nil-value* (static-symbol-offset val)) + (storew (+ nil-value (static-symbol-offset val)) fp (tn-offset y))) (character - (storew (logior (ash (char-code val) type-bits) - base-char-type) + (storew (logior (ash (char-code val) n-widetag-bits) + base-char-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)) + (storew (+ nil-value (static-symbol-offset val)) fp (- (1+ (tn-offset y))))) (character - (storew (logior (ash (char-code val) type-bits) - base-char-type) + (storew (logior (ash (char-code val) n-widetag-bits) + base-char-widetag) fp (- (1+ (tn-offset y)))))))) (if (= (tn-offset fp) esp-offset) ;; C-call @@ -221,7 +218,7 @@ (move eax x) (inst test al-tn 3) (inst jmp :z fixnum) - (loadw y eax bignum-digits-offset other-pointer-type) + (loadw y eax bignum-digits-offset other-pointer-lowtag) (inst jmp done) FIXNUM (inst sar eax 2) @@ -283,7 +280,7 @@ (:note "signed word to integer coercion") (:node-var node) (:generator 20 - (assert (not (location= x y))) + (aver (not (location= x y))) (let ((bignum (gen-label)) (done (gen-label))) (inst mov y x) @@ -293,8 +290,9 @@ (inst jmp :o bignum) (emit-label done) ;; KLUDGE: The sequence above leaves a DESCRIPTOR-REG Y in a - ;; non-descriptor state for a while. Does that matter? Does it matter in - ;; GENGC but not in GENCGC? Is this written down anywhere? + ;; non-descriptor state for a while. Does that matter? Does it + ;; matter in GENGC but not in GENCGC? Is this written down + ;; anywhere? ;; -- WHN 19990916 ;; ;; Also, the sequence above seems rather twisty. Why not something @@ -308,8 +306,8 @@ (assemble (*elsewhere*) (emit-label bignum) (with-fixed-allocation - (y bignum-type (+ bignum-digits-offset 1) node) - (storew x y bignum-digits-offset other-pointer-type)) + (y bignum-widetag (+ bignum-digits-offset 1) node) + (storew x y bignum-digits-offset other-pointer-lowtag)) (inst jmp done))))) (define-move-vop move-from-signed :move (signed-reg) (descriptor-reg)) @@ -344,9 +342,9 @@ (:node-var node) (:note "unsigned word to integer coercion") (:generator 20 - (assert (not (location= x y))) - (assert (not (location= x alloc))) - (assert (not (location= y alloc))) + (aver (not (location= x y))) + (aver (not (location= x alloc))) + (aver (not (location= y alloc))) (let ((bignum (gen-label)) (done (gen-label)) (one-word-bignum (gen-label)) @@ -365,21 +363,21 @@ ;; always allocated and the header size is set to either one ;; or two words as appropriate. (inst jmp :ns one-word-bignum) - ;; Two word bignum. + ;; two word bignum (inst mov y (logior (ash (1- (+ bignum-digits-offset 2)) - sb!vm:type-bits) - bignum-type)) + n-widetag-bits) + bignum-widetag)) (inst jmp L1) (emit-label one-word-bignum) (inst mov y (logior (ash (1- (+ bignum-digits-offset 1)) - sb!vm:type-bits) - bignum-type)) + n-widetag-bits) + bignum-widetag)) (emit-label L1) (pseudo-atomic (allocation alloc (pad-data-block (+ bignum-digits-offset 2)) node) (storew y alloc) - (inst lea y (make-ea :byte :base alloc :disp other-pointer-type)) - (storew x y bignum-digits-offset other-pointer-type)) + (inst lea y (make-ea :byte :base alloc :disp other-pointer-lowtag)) + (storew x y bignum-digits-offset other-pointer-lowtag)) (inst jmp done))))) (define-move-vop move-from-unsigned :move (unsigned-reg) (descriptor-reg))