X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmove.lisp;h=cb77175c715acb3c7cac989c302aa7d6dd39a8bb;hb=63817d29028c8551cda23f432a3328acd7fdd62f;hp=e18721d02f6b2331843f7cac035aff80112b3145;hpb=6fb6e66f531dfb6140ec3e0cc8f84f6ecd1927ca;p=sbcl.git diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index e18721d..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)) @@ -306,7 +306,7 @@ (assemble (*elsewhere*) (emit-label bignum) (with-fixed-allocation - (y bignum-type (+ bignum-digits-offset 1) node) + (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 @@ -363,15 +363,15 @@ ;; 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) @@ -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))