X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmove.lisp;h=ad715a10d85304584d140892c4aeb5ac6e1ecd60;hb=fc999187f3f80dfcf170348df676386b8403e261;hp=6edc3fc6c01bf4bc5bcc13af6063d0b10d28060c;hpb=772659782631839f87fe059a45ecb28b933e298b;p=sbcl.git diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 6edc3fc..ad715a1 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,26 +23,26 @@ (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) +(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) +(define-move-fun (load-base-char 1) (vop x y) ((immediate) (base-char-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) (sap-stack) (sap-reg) @@ -50,7 +50,7 @@ (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) (sap-reg) (sap-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) + base-char-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) + base-char-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) + base-char-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) + base-char-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) @@ -306,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)) @@ -363,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)) @@ -400,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)) @@ -413,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))