X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmove.lisp;h=cb77175c715acb3c7cac989c302aa7d6dd39a8bb;hb=0e35b321b97477bcfedaa1a5aed1fa87d635d262;hp=0286e9a0e3385cc0b6c52b8b76db4da5093a4afa;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 0286e9a..cb77175 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") -(define-move-function (load-immediate 1) (vop x y) +(define-move-fun (load-immediate 1) (vop x y) ((immediate) (any-reg descriptor-reg)) (let ((val (tn-value x))) @@ -23,36 +23,36 @@ (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) + character-widetag)))))) -(define-move-function (load-number 1) (vop x y) +(define-move-fun (load-number 1) (vop x y) ((immediate) (signed-reg unsigned-reg)) (inst mov y (tn-value x))) -(define-move-function (load-base-char 1) (vop x y) - ((immediate) (base-char-reg)) +(define-move-fun (load-character 1) (vop x y) + ((immediate) (character-reg)) (inst mov y (char-code (tn-value x)))) -(define-move-function (load-system-area-pointer 1) (vop x y) +(define-move-fun (load-system-area-pointer 1) (vop x y) ((immediate) (sap-reg)) (inst mov y (sap-int (tn-value x)))) -(define-move-function (load-constant 5) (vop x y) +(define-move-fun (load-constant 5) (vop x y) ((constant) (descriptor-reg any-reg)) (inst mov y x)) -(define-move-function (load-stack 5) (vop x y) +(define-move-fun (load-stack 5) (vop x y) ((control-stack) (any-reg descriptor-reg) - (base-char-stack) (base-char-reg) + (character-stack) (character-reg) (sap-stack) (sap-reg) (signed-stack) (signed-reg) (unsigned-stack) (unsigned-reg)) (inst mov y x)) -(define-move-function (store-stack 5) (vop x y) +(define-move-fun (store-stack 5) (vop x y) ((any-reg descriptor-reg) (control-stack) - (base-char-reg) (base-char-stack) + (character-reg) (character-stack) (sap-reg) (sap-stack) (signed-reg) (signed-stack) (unsigned-reg) (unsigned-stack)) @@ -81,26 +81,26 @@ (symbol (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) + character-widetag))))) (move y x)))) (define-move-vop move :move (any-reg descriptor-reg immediate) (any-reg descriptor-reg)) -;;; Make Move the check VOP for T so that type check generation +;;; Make MOVE the check VOP for T so that type check generation ;;; doesn't think it is a hairy type. This also allows checking of a ;;; few of the values in a continuation to fall out. (primitive-type-vop move (:check) t) -;;; The Move-Argument VOP is used for moving descriptor values into +;;; The MOVE-ARG VOP is used for moving descriptor values into ;;; another frame for argument or known value passing. ;;; ;;; Note: It is not going to be possible to move a constant directly ;;; to another frame, except if the destination is a register and in ;;; this case the loading works out. -(define-vop (move-argument) +(define-vop (move-arg) (:args (x :scs (any-reg descriptor-reg immediate) :target y :load-if (not (and (sc-is y any-reg descriptor-reg) (sc-is x control-stack)))) @@ -120,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) + character-widetag))))) (move y x))) ((control-stack) (if (sc-is x immediate) @@ -135,8 +135,8 @@ (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) + character-widetag) fp (tn-offset y)))) ;; Lisp stack (etypecase val @@ -146,8 +146,8 @@ (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) + character-widetag) fp (- (1+ (tn-offset y)))))))) (if (= (tn-offset fp) esp-offset) ;; C-call @@ -155,7 +155,7 @@ ;; Lisp stack (storew x fp (- (1+ (tn-offset y)))))))))) -(define-move-vop move-argument :move-argument +(define-move-vop move-arg :move-arg (any-reg descriptor-reg) (any-reg descriptor-reg)) @@ -218,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) @@ -290,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 @@ -305,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)) @@ -362,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)) @@ -399,7 +400,7 @@ (signed-reg unsigned-reg) (signed-reg unsigned-reg)) ;;; Move untagged number arguments/return-values. -(define-vop (move-word-argument) +(define-vop (move-word-arg) (:args (x :scs (signed-reg unsigned-reg) :target y) (fp :scs (any-reg) :load-if (not (sc-is y sap-reg)))) (:results (y)) @@ -412,10 +413,10 @@ (if (= (tn-offset fp) esp-offset) (storew x fp (tn-offset y)) ; c-call (storew x fp (- (1+ (tn-offset y))))))))) -(define-move-vop move-word-argument :move-argument +(define-move-vop move-word-arg :move-arg (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg)) -;;; Use standard MOVE-ARGUMENT and coercion to move an untagged number +;;; Use standard MOVE-ARG and coercion to move an untagged number ;;; to a descriptor passing location. -(define-move-vop move-argument :move-argument +(define-move-vop move-arg :move-arg (signed-reg unsigned-reg) (any-reg descriptor-reg))