X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fmove.lisp;h=e5b8324b494f5cd16335923e1cd1cf60dec3ba5b;hb=7deecae2d959173eda6a153d490c752c32050a9e;hp=1505ed730cff5e77b12b48ada83a452f8959156f;hpb=63817d29028c8551cda23f432a3328acd7fdd62f;p=sbcl.git diff --git a/src/compiler/ppc/move.lisp b/src/compiler/ppc/move.lisp index 1505ed7..e5b8324 100644 --- a/src/compiler/ppc/move.lisp +++ b/src/compiler/ppc/move.lisp @@ -24,7 +24,7 @@ (load-symbol y val)) (character (inst lr y (logior (ash (char-code val) n-widetag-bits) - character-widetag)))))) + character-widetag)))))) (define-move-fun (load-number 1) (vop x y) ((immediate zero) @@ -71,10 +71,10 @@ ;;;; The Move VOP: (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 @@ -93,9 +93,9 @@ ;;; 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 @@ -123,7 +123,7 @@ (:vop-var vop) (:save-p :compute-only) (:generator 666 - (error-call vop object-not-type-error x type))) + (error-call vop 'object-not-type-error x type))) @@ -141,7 +141,7 @@ (:arg-types tagged-num) (:note "fixnum untagging") (:generator 1 - (inst srawi y x 2))) + (inst srawi y x n-fixnum-tag-bits))) (define-move-vop move-to-word/fixnum :move (any-reg descriptor-reg) (signed-reg unsigned-reg)) @@ -151,7 +151,11 @@ (:results (y :scs (signed-reg unsigned-reg))) (:note "constant load") (:generator 1 - (inst lr y (tn-value x)))) + (cond ((sb!c::tn-leaf x) + (inst lr y (tn-value x))) + (t + (loadw y code-tn (tn-offset x) other-pointer-lowtag) + (inst srawi y y n-fixnum-tag-bits))))) (define-move-vop move-to-word-c :move (constant) (signed-reg unsigned-reg)) @@ -163,16 +167,16 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:generator 4 (let ((done (gen-label))) - (inst andi. temp x 3) + (inst andi. temp x fixnum-tag-mask) (sc-case y - (signed-reg - (inst srawi y x 2)) - (unsigned-reg - (inst srwi y x 2))) - + (signed-reg + (inst srawi y x n-fixnum-tag-bits)) + (unsigned-reg + (inst srwi y x n-fixnum-tag-bits))) + (inst beq done) (loadw y x bignum-digits-offset other-pointer-lowtag) - + (emit-label done)))) (define-move-vop move-to-word/integer :move (descriptor-reg) (signed-reg unsigned-reg)) @@ -185,7 +189,7 @@ (:result-types tagged-num) (:note "fixnum tagging") (:generator 1 - (inst slwi y x 2))) + (inst slwi y x n-fixnum-tag-bits))) (define-move-vop move-from-word/fixnum :move (signed-reg unsigned-reg) (any-reg descriptor-reg)) @@ -203,11 +207,11 @@ (inst mtxer zero-tn) ; clear sticky overflow bit in XER, CR0 (inst addo temp x x) ; set XER OV if top two bits differ (inst addo. temp temp temp) ; set CR0 SO if any top three bits differ - (inst slwi y x 2) ; assume fixnum (tagged ok, maybe lost some high bits) + (inst slwi y x n-fixnum-tag-bits) ; assume fixnum (tagged ok, maybe lost some high bits) (inst bns done) - + (with-fixed-allocation (y pa-flag temp bignum-widetag (1+ bignum-digits-offset)) - (storew x y bignum-digits-offset other-pointer-lowtag)) + (storew x y bignum-digits-offset other-pointer-lowtag)) (emit-label done)))) (define-move-vop move-from-signed :move (signed-reg) (descriptor-reg)) @@ -224,24 +228,20 @@ (:generator 20 (move x arg) (let ((done (gen-label)) - (one-word (gen-label)) - (initial-alloc (pad-data-block (1+ bignum-digits-offset)))) - (inst srawi. temp x 29) - (inst slwi y x 2) + (one-word (gen-label))) + (inst srawi. temp x n-positive-fixnum-bits) + (inst slwi y x n-fixnum-tag-bits) (inst beq done) - - (pseudo-atomic (pa-flag :extra initial-alloc) - (inst cmpwi x 0) - (inst ori y alloc-tn other-pointer-lowtag) - (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag)) - (inst bge one-word) - (inst addi alloc-tn alloc-tn - (- (pad-data-block (+ bignum-digits-offset 2)) - (pad-data-block (+ bignum-digits-offset 1)))) - (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag)) - (emit-label one-word) - (storew temp y 0 other-pointer-lowtag) - (storew x y bignum-digits-offset other-pointer-lowtag)) + + (with-fixed-allocation + (y pa-flag temp bignum-widetag (+ 2 bignum-digits-offset)) + (inst cmpwi x 0) + (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag)) + (inst bge one-word) + (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag)) + (emit-label one-word) + (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 (unsigned-reg) (descriptor-reg)) @@ -250,10 +250,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") @@ -266,9 +266,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