X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Fmove.lisp;h=72080a2e1cab31c1ea244ef2b3fea62007d22314;hb=5745b5a5b2e3b967bf3876b4306f31b3c78495fa;hp=4ff9eb552e6f9d4cccd44deccca0c13132dcaebc;hpb=ea775867d48327bf1179eb570263427f28083880;p=sbcl.git diff --git a/src/compiler/sparc/move.lisp b/src/compiler/sparc/move.lisp index 4ff9eb5..72080a2 100644 --- a/src/compiler/sparc/move.lisp +++ b/src/compiler/sparc/move.lisp @@ -24,15 +24,15 @@ (load-symbol y val)) (character (inst li y (logior (ash (char-code val) n-widetag-bits) - base-char-widetag)))))) + character-widetag)))))) (define-move-fun (load-number 1) (vop x y) ((immediate zero) (signed-reg unsigned-reg)) (inst li y (tn-value x))) -(define-move-fun (load-base-char 1) (vop x y) - ((immediate) (base-char-reg)) +(define-move-fun (load-character 1) (vop x y) + ((immediate) (character-reg)) (inst li y (char-code (tn-value x)))) (define-move-fun (load-system-area-pointer 1) (vop x y) @@ -48,7 +48,7 @@ (load-stack-tn y x)) (define-move-fun (load-number-stack 5) (vop x y) - ((base-char-stack) (base-char-reg) + ((character-stack) (character-reg) (sap-stack) (sap-reg) (signed-stack) (signed-reg) (unsigned-stack) (unsigned-reg)) @@ -60,7 +60,7 @@ (store-stack-tn y x)) (define-move-fun (store-number-stack 5) (vop x y) - ((base-char-reg) (base-char-stack) + ((character-reg) (character-stack) (sap-reg) (sap-stack) (signed-reg) (signed-stack) (unsigned-reg) (unsigned-stack)) @@ -72,10 +72,10 @@ (define-vop (move) (:args (x :target y - :scs (any-reg descriptor-reg zero null) - :load-if (not (location= x y)))) + :scs (any-reg descriptor-reg zero null) + :load-if (not (location= x y)))) (:results (y :scs (any-reg descriptor-reg) - :load-if (not (location= x y)))) + :load-if (not (location= x y)))) (:effects) (:affected) (:generator 0 @@ -94,9 +94,9 @@ ;;; another frame for argument or known value passing. (define-vop (move-arg) (:args (x :target y - :scs (any-reg descriptor-reg zero null)) - (fp :scs (any-reg) - :load-if (not (sc-is y any-reg descriptor-reg)))) + :scs (any-reg descriptor-reg zero null)) + (fp :scs (any-reg) + :load-if (not (sc-is y any-reg descriptor-reg)))) (:results (y)) (:generator 0 (sc-case y @@ -150,7 +150,11 @@ (:results (y :scs (signed-reg unsigned-reg))) (:note "constant load") (:generator 1 - (inst li y (tn-value x)))) + (cond ((sb!c::tn-leaf x) + (inst li y (tn-value x))) + (t + (loadw y code-tn (tn-offset x) other-pointer-lowtag) + (inst sra y y n-fixnum-tag-bits))))) (define-move-vop move-to-word-c :move (constant) (signed-reg unsigned-reg)) @@ -167,9 +171,9 @@ (inst andcc temp x fixnum-tag-mask) (inst b :eq done) (inst sra y x n-fixnum-tag-bits) - + (loadw y x bignum-digits-offset other-pointer-lowtag) - + (emit-label done)))) (define-move-vop move-to-word/integer :move @@ -199,20 +203,20 @@ (:generator 20 (move x arg) (let ((fixnum (gen-label)) - (done (gen-label))) + (done (gen-label))) (inst sra temp x n-positive-fixnum-bits) (inst cmp temp) (inst b :eq fixnum) (inst orncc temp zero-tn temp) (inst b :eq done) (inst sll y x n-fixnum-tag-bits) - + (with-fixed-allocation - (y temp bignum-widetag (1+ bignum-digits-offset)) - (storew x y bignum-digits-offset other-pointer-lowtag)) + (y temp bignum-widetag (1+ bignum-digits-offset)) + (storew x y bignum-digits-offset other-pointer-lowtag)) (inst b done) (inst nop) - + (emit-label fixnum) (inst sll y x n-fixnum-tag-bits) (emit-label done)))) @@ -232,8 +236,7 @@ (:generator 20 (move x arg) (let ((done (gen-label)) - (one-word (gen-label)) - (initial-alloc (pad-data-block (1+ bignum-digits-offset)))) + (one-word (gen-label))) (inst sra temp x n-positive-fixnum-bits) (inst cmp temp) (inst b :eq done) @@ -242,17 +245,17 @@ ;; We always allocate 2 words even if we don't need it. (The ;; copying GC will take care of freeing the unused extra word.) (with-fixed-allocation - (y temp bignum-widetag (+ 2 bignum-digits-offset)) - (inst cmp x) - (inst b :ge one-word) - (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag)) - (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag)) - (emit-label one-word) - ;; Set the header word, then the actual digit. The extra - ;; digit, if any, is automatically set to zero, so we don't - ;; have to. - (storew temp y 0 other-pointer-lowtag) - (storew x y bignum-digits-offset other-pointer-lowtag)) + (y temp bignum-widetag (+ 2 bignum-digits-offset)) + (inst cmp x) + (inst b :ge one-word) + (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag)) + (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag)) + (emit-label one-word) + ;; Set the header word, then the actual digit. The extra + ;; digit, if any, is automatically set to zero, so we don't + ;; have to. + (storew temp y 0 other-pointer-lowtag) + (storew x y bignum-digits-offset other-pointer-lowtag)) (emit-label done)))) (define-move-vop move-from-unsigned :move @@ -262,10 +265,10 @@ ;;; Move untagged numbers. (define-vop (word-move) (:args (x :target y - :scs (signed-reg unsigned-reg) - :load-if (not (location= x y)))) + :scs (signed-reg unsigned-reg) + :load-if (not (location= x y)))) (:results (y :scs (signed-reg unsigned-reg) - :load-if (not (location= x y)))) + :load-if (not (location= x y)))) (:effects) (:affected) (:note "word integer move") @@ -279,9 +282,9 @@ ;;; Move untagged number arguments/return-values. (define-vop (move-word-arg) (:args (x :target y - :scs (signed-reg unsigned-reg)) - (fp :scs (any-reg) - :load-if (not (sc-is y sap-reg)))) + :scs (signed-reg unsigned-reg)) + (fp :scs (any-reg) + :load-if (not (sc-is y sap-reg)))) (:results (y)) (:note "word integer argument move") (:generator 0