X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fmove.lisp;h=a948dee3b09ed34bbc0b31aed1de6f527f6bcc0e;hb=49e8403800426f37a54d9b87353a31af36e7af40;hp=21f330f45ae57998a97728408a9760137f6626f6;hpb=52cfe54802db8736f1f4e2b67764c43bba9b78b3;p=sbcl.git diff --git a/src/compiler/ppc/move.lisp b/src/compiler/ppc/move.lisp index 21f330f..a948dee 100644 --- a/src/compiler/ppc/move.lisp +++ b/src/compiler/ppc/move.lisp @@ -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)) @@ -224,20 +228,16 @@ (: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 srawi. temp x 29) (inst slwi y x 2) (inst beq done) - (pseudo-atomic (pa-flag :extra initial-alloc) + (with-fixed-allocation + (y pa-flag temp bignum-widetag (+ 2 bignum-digits-offset)) (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)