X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Fmove.lisp;h=68e25bc2e2faa5b98e8eeac9909a2818e7002d75;hb=7deecae2d959173eda6a153d490c752c32050a9e;hp=724ab938dea6ebf5df1ad6bd4caba9155eec71d4;hpb=0d74ed478e7f3af5d3292153726373763631aa8e;p=sbcl.git diff --git a/src/compiler/hppa/move.lisp b/src/compiler/hppa/move.lisp index 724ab93..68e25bc 100644 --- a/src/compiler/hppa/move.lisp +++ b/src/compiler/hppa/move.lisp @@ -143,7 +143,7 @@ (:arg-types tagged-num) (:note "fixnum untagging") (:generator 1 - (inst sra x 2 y))) + (inst sra x n-fixnum-tag-bits y))) (define-move-vop move-to-word/fixnum :move (any-reg descriptor-reg) (signed-reg unsigned-reg)) @@ -154,7 +154,11 @@ (:results (y :scs (signed-reg unsigned-reg))) (:note "constant load") (:generator 1 - (inst li (tn-value x) y))) + (cond ((sb!c::tn-leaf x) + (inst li (tn-value x) y)) + (t + (loadw y code-tn (tn-offset x) other-pointer-lowtag) + (inst sra y n-fixnum-tag-bits y))))) (define-move-vop move-to-word-c :move (constant) (signed-reg unsigned-reg)) @@ -165,7 +169,7 @@ (:results (y :scs (signed-reg unsigned-reg))) (:note "integer to untagged word coercion") (:generator 3 - (inst sra x 2 y) + (inst sra x n-fixnum-tag-bits y) (inst extru x 31 2 zero-tn :=) (loadw y x bignum-digits-offset other-pointer-lowtag))) @@ -180,7 +184,7 @@ (:result-types tagged-num) (:note "fixnum tagging") (:generator 1 - (inst sll x 2 y))) + (inst sll x n-fixnum-tag-bits y))) (define-move-vop move-from-word/fixnum :move (signed-reg unsigned-reg) (any-reg descriptor-reg)) @@ -202,7 +206,7 @@ ;; If we are left with zero, it will fit in a fixnum. So branch around ;; the bignum-construction, doing the shift in the delay slot. (inst comb := temp zero-tn done) - (inst sll x 2 y) + (inst sll x n-fixnum-tag-bits y) ;; Make a single-digit bignum. (with-fixed-allocation (y nil temp bignum-widetag (1+ bignum-digits-offset) nil) @@ -222,9 +226,9 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp) (:generator 20 (move arg x) - (inst srl x 29 temp) + (inst srl x n-positive-fixnum-bits temp) (inst comb := temp zero-tn done) - (inst sll x 2 y) + (inst sll x n-fixnum-tag-bits y) (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 2))) (set-lowtag other-pointer-lowtag alloc-tn y) (inst xor temp temp temp)