From: Nathan Froyd Date: Thu, 17 Dec 2009 21:01:47 +0000 (+0000) Subject: 1.0.33.20: MORE CONSTANTIFICATION X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7deecae2d959173eda6a153d490c752c32050a9e;p=sbcl.git 1.0.33.20: MORE CONSTANTIFICATION Use FIXNUM-TAG-MASK and N-FIXNUM-TAG-BITS where appropriate. --- diff --git a/src/compiler/alpha/system.lisp b/src/compiler/alpha/system.lisp index 5a9945a..c79d117 100644 --- a/src/compiler/alpha/system.lisp +++ b/src/compiler/alpha/system.lisp @@ -116,7 +116,7 @@ (inst and t1 widetag-mask t1) (sc-case data (any-reg - (inst sll data (- n-widetag-bits 2) t2) + (inst sll data (- n-widetag-bits n-fixnum-tag-bits) t2) (inst bis t1 t2 t1)) (immediate (let ((c (ash (tn-value data) n-widetag-bits))) diff --git a/src/compiler/hppa/move.lisp b/src/compiler/hppa/move.lisp index 67b535b..68e25bc 100644 --- a/src/compiler/hppa/move.lisp +++ b/src/compiler/hppa/move.lisp @@ -169,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))) @@ -184,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)) @@ -206,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) @@ -226,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) diff --git a/src/compiler/hppa/system.lisp b/src/compiler/hppa/system.lisp index c156406..c99cab8 100644 --- a/src/compiler/hppa/system.lisp +++ b/src/compiler/hppa/system.lisp @@ -29,7 +29,7 @@ (inst li (logxor other-pointer-lowtag fun-pointer-lowtag) temp2) (inst xor temp1 temp2 temp1) (inst comb := temp1 zero-tn FUNCTION-PTR) - (inst li 3 temp1) ; pick off fixnums + (inst li fixnum-tag-mask temp1) ; pick off fixnums (inst li 1 temp2) (inst and temp1 object result) (inst comb := result zero-tn DONE) @@ -129,7 +129,7 @@ (:results (res :scs (any-reg descriptor-reg))) (:policy :fast-safe) (:generator 1 - (inst zdep ptr 29 29 res))) + (inst zdep ptr n-positive-fixnum-bits n-positive-fixnum-bits res))) (define-vop (make-other-immediate-type) (:args (val :scs (any-reg descriptor-reg)) diff --git a/src/compiler/mips/alloc.lisp b/src/compiler/mips/alloc.lisp index 4c37b2c..88d5d74 100644 --- a/src/compiler/mips/alloc.lisp +++ b/src/compiler/mips/alloc.lisp @@ -260,7 +260,7 @@ (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) (:generator 6 (inst addu bytes extra (* (1+ words) n-word-bytes)) - (inst sll header bytes (- n-widetag-bits 2)) + (inst sll header bytes (- n-widetag-bits n-fixnum-tag-bits)) (inst addu header header (+ (ash -2 n-widetag-bits) type)) (inst srl bytes bytes n-lowtag-bits) (inst sll bytes bytes n-lowtag-bits) diff --git a/src/compiler/mips/move.lisp b/src/compiler/mips/move.lisp index 5bb0c85..ae0c33b 100644 --- a/src/compiler/mips/move.lisp +++ b/src/compiler/mips/move.lisp @@ -169,9 +169,9 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:generator 3 (let ((done (gen-label))) - (inst and temp x 3) + (inst and temp x fixnum-tag-mask) (inst beq temp done) - (inst sra y x 2) + (inst sra y x n-fixnum-tag-bits) (loadw y x bignum-digits-offset other-pointer-lowtag) (emit-label done)))) @@ -189,7 +189,7 @@ (:result-types tagged-num) (:note "fixnum tagging") (:generator 1 - (inst sll y x 2))) + (inst sll y x n-fixnum-tag-bits))) ;;; (define-move-vop move-from-word/fixnum :move (signed-reg unsigned-reg) (any-reg descriptor-reg)) @@ -207,11 +207,11 @@ (move x arg) (let ((fixnum (gen-label)) (done (gen-label))) - (inst sra temp x 29) + (inst sra temp x n-positive-fixnum-bits) (inst beq temp fixnum) (inst nor temp zero-tn) (inst beq temp done) - (inst sll y x 2) + (inst sll y x n-fixnum-tag-bits) (with-fixed-allocation (y pa-flag temp bignum-widetag (1+ bignum-digits-offset) nil) @@ -220,7 +220,7 @@ (inst nop) (emit-label fixnum) - (inst sll y x 2) + (inst sll y x n-fixnum-tag-bits) (emit-label done)))) ;;; (define-move-vop move-from-signed :move @@ -238,9 +238,9 @@ (:note "unsigned word to integer coercion") (:generator 20 (move x arg) - (inst srl temp x 29) + (inst srl temp x n-positive-fixnum-bits) (inst beq temp done) - (inst sll y x 2) + (inst sll y x n-fixnum-tag-bits) (pseudo-atomic (pa-flag :extra (pad-data-block (+ bignum-digits-offset 2))) diff --git a/src/compiler/mips/system.lisp b/src/compiler/mips/system.lisp index 4ac025c..e5841e5 100644 --- a/src/compiler/mips/system.lisp +++ b/src/compiler/mips/system.lisp @@ -39,7 +39,7 @@ (inst beq ndescr function-ptr) ;; Pick off fixnums. - (inst and result object 3) + (inst and result object fixnum-tag-mask) (inst beq result done) ;; Pick off structure and list pointers. @@ -122,7 +122,7 @@ (inst and t1 widetag-mask) (sc-case data (any-reg - (inst sll t2 data (- n-widetag-bits 2)) + (inst sll t2 data (- n-widetag-bits n-fixnum-tag-bits)) (inst or t1 t2)) (immediate (inst or t1 (ash (tn-value data) n-widetag-bits))) @@ -153,8 +153,8 @@ (inst sll temp val n-widetag-bits) (inst or res temp (tn-value type))) (t - (inst sra temp type 2) - (inst sll res val (- n-widetag-bits 2)) + (inst sra temp type n-fixnum-tag-bits) + (inst sll res val (- n-widetag-bits n-fixnum-tag-bits)) (inst or res res temp))))) diff --git a/src/compiler/ppc/alloc.lisp b/src/compiler/ppc/alloc.lisp index d2b5a2a..58d9547 100644 --- a/src/compiler/ppc/alloc.lisp +++ b/src/compiler/ppc/alloc.lisp @@ -197,7 +197,7 @@ (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) (:generator 6 (inst addi bytes extra (* (1+ words) n-word-bytes)) - (inst slwi header bytes (- n-widetag-bits 2)) + (inst slwi header bytes (- n-widetag-bits n-fixnum-tag-bits)) (inst addi header header (+ (ash -2 n-widetag-bits) type)) (inst clrrwi bytes bytes n-lowtag-bits) (pseudo-atomic (pa-flag) diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp index 4cbfbb0..f8cb9aa 100644 --- a/src/compiler/ppc/arith.lisp +++ b/src/compiler/ppc/arith.lisp @@ -459,7 +459,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:translate *) (:generator 2 - (inst srawi temp y 2) + (inst srawi temp y n-fixnum-tag-bits) (inst mullw r x temp))) (define-vop (fast-*-c/fixnum=>fixnum fast-fixnum-binop-c) @@ -1165,7 +1165,7 @@ (:results (digit :scs (unsigned-reg))) (:result-types unsigned-num) (:generator 1 - (inst srawi digit fixnum 2))) + (inst srawi digit fixnum n-fixnum-tag-bits))) (define-vop (bignum-floor) @@ -1232,7 +1232,7 @@ (:generator 1 (sc-case res (any-reg - (inst slwi res digit 2)) + (inst slwi res digit n-fixnum-tag-bits)) (signed-reg (move res digit))))) diff --git a/src/compiler/ppc/char.lisp b/src/compiler/ppc/char.lisp index f0ab865..92ea7b3 100644 --- a/src/compiler/ppc/char.lisp +++ b/src/compiler/ppc/char.lisp @@ -81,7 +81,7 @@ (:results (res :scs (any-reg))) (:result-types positive-fixnum) (:generator 1 - (inst slwi res ch 2))) + (inst slwi res ch n-fixnum-tag-bits))) (define-vop (code-char) (:translate code-char) @@ -91,7 +91,7 @@ (:results (res :scs (character-reg))) (:result-types character) (:generator 1 - (inst srwi res code 2))) + (inst srwi res code n-fixnum-tag-bits))) ;;; Comparison of characters. (define-vop (character-compare) diff --git a/src/compiler/ppc/move.lisp b/src/compiler/ppc/move.lisp index a948dee..e5b8324 100644 --- a/src/compiler/ppc/move.lisp +++ b/src/compiler/ppc/move.lisp @@ -167,12 +167,12 @@ (: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)) + (inst srawi y x n-fixnum-tag-bits)) (unsigned-reg - (inst srwi y x 2))) + (inst srwi y x n-fixnum-tag-bits))) (inst beq done) (loadw y x bignum-digits-offset other-pointer-lowtag) @@ -189,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)) @@ -207,7 +207,7 @@ (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)) @@ -229,8 +229,8 @@ (move x arg) (let ((done (gen-label)) (one-word (gen-label))) - (inst srawi. temp x 29) - (inst slwi y x 2) + (inst srawi. temp x n-positive-fixnum-bits) + (inst slwi y x n-fixnum-tag-bits) (inst beq done) (with-fixed-allocation diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp index b5ed227..301da10 100644 --- a/src/compiler/ppc/system.lisp +++ b/src/compiler/ppc/system.lisp @@ -42,7 +42,7 @@ (inst beq done) ;; Okay, it is an immediate. If fixnum, we want zero. Otherwise, ;; we want the low 8 bits. - (inst andi. result object #b11) + (inst andi. result object fixnum-tag-mask) (inst beq done) ;; It wasn't a fixnum, so get the low 8 bits. (inst andi. result object widetag-mask) @@ -112,7 +112,7 @@ (inst andi. t1 t1 widetag-mask) (sc-case data (any-reg - (inst slwi t2 data (- n-widetag-bits 2)) + (inst slwi t2 data (- n-widetag-bits n-fixnum-tag-bits)) (inst or t1 t1 t2)) (immediate (inst ori t1 t1 (ash (tn-value data) n-widetag-bits))) @@ -143,8 +143,8 @@ (inst slwi temp val n-widetag-bits) (inst ori res temp (tn-value type))) (t - (inst srawi temp type 2) - (inst slwi res val (- n-widetag-bits 2)) + (inst srawi temp type n-fixnum-tag-bits) + (inst slwi res val (- n-widetag-bits n-fixnum-tag-bits)) (inst or res res temp))))) diff --git a/src/compiler/ppc/type-vops.lisp b/src/compiler/ppc/type-vops.lisp index 4e46b6d..712d4de 100644 --- a/src/compiler/ppc/type-vops.lisp +++ b/src/compiler/ppc/type-vops.lisp @@ -164,7 +164,7 @@ (if not-p (values not-target target) (values target not-target)) - (inst andi. temp value #x3) + (inst andi. temp value fixnum-tag-mask) (inst beq yep) (test-type value nope t (other-pointer-lowtag) :temp temp) (loadw temp value 0 other-pointer-lowtag) @@ -177,7 +177,7 @@ (:generator 45 (let ((nope (generate-error-code vop 'object-not-signed-byte-32-error value)) (yep (gen-label))) - (inst andi. temp value #x3) + (inst andi. temp value fixnum-tag-mask) (inst beq yep) (test-type value nope t (other-pointer-lowtag) :temp temp) (loadw temp value 0 other-pointer-lowtag) @@ -203,7 +203,7 @@ (values not-target target) (values target not-target)) ;; Is it a fixnum? - (inst andi. temp value #x3) + (inst andi. temp value fixnum-tag-mask) (inst cmpwi :cr1 value 0) (inst beq fixnum) @@ -244,7 +244,7 @@ (fixnum (gen-label)) (single-word (gen-label))) ;; Is it a fixnum? - (inst andi. temp value #x3) + (inst andi. temp value fixnum-tag-mask) (inst cmpwi :cr1 value 0) (inst beq fixnum) diff --git a/src/compiler/sparc/cell.lisp b/src/compiler/sparc/cell.lisp index 20a4a5b..4cea77a 100644 --- a/src/compiler/sparc/cell.lisp +++ b/src/compiler/sparc/cell.lisp @@ -289,7 +289,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -311,7 +311,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -333,7 +333,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -355,7 +355,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -378,7 +378,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -400,7 +400,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -423,7 +423,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -447,7 +447,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -478,7 +478,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset @@ -502,7 +502,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset offset n-widetag-bits) - (inst sll offset offset 2) + (inst sll offset offset n-fixnum-tag-bits) (inst sub offset offset index) (inst add offset diff --git a/src/compiler/sparc/system.lisp b/src/compiler/sparc/system.lisp index 576dac2..0e5b993 100644 --- a/src/compiler/sparc/system.lisp +++ b/src/compiler/sparc/system.lisp @@ -42,7 +42,7 @@ (inst b :eq done) ;; Okay, it is an immediate. If fixnum, we want zero. Otherwise, ;; we want the low 8 bits. - (inst andcc zero-tn object #b11) + (inst andcc zero-tn object fixnum-tag-mask) (inst b :eq done) (inst li result 0) ;; It wasn't a fixnum, so get the low 8 bits. @@ -117,7 +117,7 @@ (inst and t1 widetag-mask) (sc-case data (any-reg - (inst sll t2 data (- n-widetag-bits 2)) + (inst sll t2 data (- n-widetag-bits n-fixnum-tag-bits)) (inst or t1 t2)) (immediate (inst or t1 (ash (tn-value data) n-widetag-bits))) @@ -149,8 +149,8 @@ (inst sll temp val n-widetag-bits) (inst or res temp (tn-value type))) (t - (inst sra temp type 2) - (inst sll res val (- n-widetag-bits 2)) + (inst sra temp type n-fixnum-tag-bits) + (inst sll res val (- n-widetag-bits n-fixnum-tag-bits)) (inst or res res temp))))) diff --git a/src/compiler/sparc/type-vops.lisp b/src/compiler/sparc/type-vops.lisp index 960ce71..9c6fdb8 100644 --- a/src/compiler/sparc/type-vops.lisp +++ b/src/compiler/sparc/type-vops.lisp @@ -183,7 +183,7 @@ (if not-p (values not-target target) (values target not-target)) - (inst andcc zero-tn value #x3) + (inst andcc zero-tn value fixnum-tag-mask) (inst b :eq yep) (test-type value nope t (other-pointer-lowtag) :temp temp) (loadw temp value 0 other-pointer-lowtag) @@ -197,7 +197,7 @@ (:generator 45 (let ((nope (generate-error-code vop object-not-signed-byte-32-error value)) (yep (gen-label))) - (inst andcc temp value #x3) + (inst andcc temp value fixnum-tag-mask) (inst b :eq yep) (test-type value nope t (other-pointer-lowtag) :temp temp) (loadw temp value 0 other-pointer-lowtag) @@ -225,7 +225,7 @@ (values not-target target) (values target not-target)) ;; Is it a fixnum? - (inst andcc temp value #x3) + (inst andcc temp value fixnum-tag-mask) (inst b :eq fixnum) (inst cmp value) @@ -270,7 +270,7 @@ (fixnum (gen-label)) (single-word (gen-label))) ;; Is it a fixnum? - (inst andcc temp value #x3) + (inst andcc temp value fixnum-tag-mask) (inst b :eq fixnum) (inst cmp value) diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index 4735ce3..cfe4ad4 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -509,8 +509,9 @@ (inst cqo) (inst idiv eax y) (if (location= quo eax) - (inst shl eax 3) - (inst lea quo (make-ea :qword :index eax :scale 8))) + (inst shl eax n-fixnum-tag-bits) + (inst lea quo (make-ea :qword :index eax + :scale (ash 1 n-fixnum-tag-bits)))) (move rem edx))) (define-vop (fast-truncate-c/fixnum=>fixnum fast-safe-arith-op) @@ -537,8 +538,9 @@ (setf y-arg (register-inline-constant :qword (fixnumize y)))) (inst idiv eax y-arg) (if (location= quo eax) - (inst shl eax 3) - (inst lea quo (make-ea :qword :index eax :scale 8))) + (inst shl eax n-fixnum-tag-bits) + (inst lea quo (make-ea :qword :index eax + :scale (ash 1 n-fixnum-tag-bits)))) (move rem edx))) (define-vop (fast-truncate/unsigned=>unsigned fast-safe-arith-op) diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 632e19e..a5114eb 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -530,7 +530,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (inst mov value (make-ea-for-raw-slot object index tmp)))) @@ -563,7 +563,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (inst mov (make-ea-for-raw-slot object index tmp) value) (move result value))) @@ -626,7 +626,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (inst movss value (make-ea-for-raw-slot object index tmp)))) @@ -659,7 +659,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (inst movss (make-ea-for-raw-slot object index tmp) value) (move result value))) @@ -703,7 +703,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (inst movsd value (make-ea-for-raw-slot object index tmp)))) @@ -736,7 +736,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (inst movsd (make-ea-for-raw-slot object index tmp) value) (move result value))) @@ -780,7 +780,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (inst movq value (make-ea-for-raw-slot object index tmp)))) @@ -813,7 +813,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (move result value) (inst movq (make-ea-for-raw-slot object index tmp) value))) @@ -857,7 +857,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (inst movdqu value (make-ea-for-raw-slot object index tmp -8)))) @@ -890,7 +890,7 @@ (:generator 5 (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) - (inst shl tmp 3) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index) (move result value) (inst movdqu (make-ea-for-raw-slot object index tmp -8) value))) diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp index b5c628b..be974f2 100644 --- a/src/compiler/x86-64/move.lisp +++ b/src/compiler/x86-64/move.lisp @@ -238,7 +238,7 @@ (:note "fixnum untagging") (:generator 1 (move y x) - (inst sar y (1- n-lowtag-bits)))) + (inst sar y n-fixnum-tag-bits))) (define-move-vop move-to-word/fixnum :move (any-reg descriptor-reg) (signed-reg unsigned-reg)) @@ -266,12 +266,12 @@ :from (:argument 0) :to (:result 0) :target y) eax) (:generator 4 (move eax x) - (inst test al-tn 7) ; a symbolic constant for this - (inst jmp :z FIXNUM) ; would be nice + (inst test al-tn fixnum-tag-mask) + (inst jmp :z FIXNUM) (loadw y eax bignum-digits-offset other-pointer-lowtag) (inst jmp DONE) FIXNUM - (inst sar eax (1- n-lowtag-bits)) + (inst sar eax n-fixnum-tag-bits) (move y eax) DONE)) (define-move-vop move-to-word/integer :move @@ -291,11 +291,12 @@ (cond ((and (sc-is x signed-reg unsigned-reg) (not (location= x y))) ;; Uses 7 bytes, but faster on the Pentium - (inst lea y (make-ea :qword :index x :scale 8))) + (inst lea y (make-ea :qword :index x + :scale (ash 1 n-fixnum-tag-bits)))) (t ;; Uses: If x is a reg 2 + 3; if x = y uses only 3 bytes (move y x) - (inst shl y (1- n-lowtag-bits)))))) + (inst shl y n-fixnum-tag-bits))))) (define-move-vop move-from-word/fixnum :move (signed-reg unsigned-reg) (any-reg descriptor-reg)) @@ -346,7 +347,7 @@ (:generator 20 (aver (not (location= x y))) (let ((done (gen-label))) - (inst mov y #.(ash lowtag-mask (- n-word-bits n-fixnum-tag-bits 1))) + (inst mov y #.(ash lowtag-mask n-positive-fixnum-bits)) ;; The assembly routines test the sign flag from this one, so if ;; you change stuff here, make sure the sign flag doesn't get ;; overwritten before the CALL! @@ -354,7 +355,7 @@ ;; Faster but bigger then SHL Y 4. The cost of doing this ;; speculatively should be noise compared to bignum consing if ;; that is needed and saves one branch. - (inst lea y (make-ea :qword :index x :scale 8)) + (inst lea y (make-ea :qword :index x :scale (ash 1 n-fixnum-tag-bits))) (inst jmp :z done) (inst mov y x) (inst lea temp-reg-tn diff --git a/src/compiler/x86-64/system.lisp b/src/compiler/x86-64/system.lisp index ce91fb4..46eedb5 100644 --- a/src/compiler/x86-64/system.lisp +++ b/src/compiler/x86-64/system.lisp @@ -44,7 +44,7 @@ (inst jmp :ne DONE) ;; Pick off fixnums. - (inst and al-tn 7) + (inst and al-tn fixnum-tag-mask) (inst jmp :e DONE) ;; must be an other immediate diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index d16a2ff..4abd9c6 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -359,7 +359,7 @@ (:note "inline fixnum arithmetic") (:generator 4 (move r x) - (inst sar r 2) + (inst sar r n-fixnum-tag-bits) (inst imul r y))) (define-vop (fast-*-c/fixnum=>fixnum fast-safe-arith-op) @@ -445,8 +445,9 @@ (inst cdq) (inst idiv eax y) (if (location= quo eax) - (inst shl eax 2) - (inst lea quo (make-ea :dword :index eax :scale 4))) + (inst shl eax n-fixnum-tag-bits) + (inst lea quo (make-ea :dword :index eax + :scale (ash 1 n-fixnum-tag-bits)))) (move rem edx))) (define-vop (fast-truncate-c/fixnum=>fixnum fast-safe-arith-op) @@ -471,8 +472,9 @@ (inst mov y-arg (fixnumize y)) (inst idiv eax y-arg) (if (location= quo eax) - (inst shl eax 2) - (inst lea quo (make-ea :dword :index eax :scale 4))) + (inst shl eax n-fixnum-tag-bits) + (inst lea quo (make-ea :dword :index eax + :scale (ash 1 n-fixnum-tag-bits)))) (move rem edx))) (define-vop (fast-truncate/unsigned=>unsigned fast-safe-arith-op) @@ -1581,7 +1583,7 @@ (:result-types unsigned-num) (:generator 1 (move digit fixnum) - (inst sar digit 2))) + (inst sar digit n-fixnum-tag-bits))) (define-vop (bignum-floor) (:translate sb!bignum:%floor) @@ -1617,7 +1619,7 @@ (:generator 1 (move res digit) (when (sc-is res any-reg control-stack) - (inst shl res 2)))) + (inst shl res n-fixnum-tag-bits)))) (define-vop (digit-ashr) (:translate sb!bignum:%ashr) diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 2590000..d89f989 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -504,7 +504,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (inst mov value (make-ea-for-raw-slot object index tmp 1)))) @@ -522,7 +522,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (inst mov (make-ea-for-raw-slot object index tmp 1) value) (move result value))) @@ -549,7 +549,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (inst xadd (make-ea-for-raw-slot object index tmp 1) diff :lock) (move result diff))) @@ -566,7 +566,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (with-empty-tn@fp-top(value) (inst fld (make-ea-for-raw-slot object index tmp 1))))) @@ -585,7 +585,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (unless (zerop (tn-offset value)) (inst fxch value)) @@ -622,7 +622,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (with-empty-tn@fp-top(value) (inst fldd (make-ea-for-raw-slot object index tmp 2))))) @@ -641,7 +641,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (unless (zerop (tn-offset value)) (inst fxch value)) @@ -679,7 +679,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (let ((real-tn (complex-single-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) @@ -702,7 +702,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (let ((value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result))) @@ -758,7 +758,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (let ((real-tn (complex-double-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) @@ -781,7 +781,7 @@ (loadw tmp object 0 instance-pointer-lowtag) (inst shr tmp n-widetag-bits) (when (sc-is index any-reg) - (inst shl tmp 2) + (inst shl tmp n-fixnum-tag-bits) (inst sub tmp index)) (let ((value-real (complex-double-reg-real-tn value)) (result-real (complex-double-reg-real-tn result))) diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 344c572..eb752ba 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -178,12 +178,12 @@ :from (:argument 0) :to (:result 0) :target y) eax) (:generator 4 (move eax x) - (inst test al-tn 3) + (inst test al-tn fixnum-tag-mask) (inst jmp :z fixnum) (loadw y eax bignum-digits-offset other-pointer-lowtag) (inst jmp done) FIXNUM - (inst sar eax 2) + (inst sar eax n-fixnum-tag-bits) (move y eax) DONE)) (define-move-vop move-to-word/integer :move @@ -203,11 +203,12 @@ (cond ((and (sc-is x signed-reg unsigned-reg) (not (location= x y))) ;; Uses 7 bytes, but faster on the Pentium - (inst lea y (make-ea :dword :index x :scale 4))) + (inst lea y (make-ea :dword :index x + :scale (ash 1 n-fixnum-tag-bits)))) (t ;; Uses: If x is a reg 2 + 3; if x = y uses only 3 bytes (move y x) - (inst shl y 2))))) + (inst shl y n-fixnum-tag-bits))))) (define-move-vop move-from-word/fixnum :move (signed-reg unsigned-reg) (any-reg descriptor-reg)) @@ -251,10 +252,10 @@ ;; The assembly routines test the sign flag from this one, so if ;; you change stuff here, make sure the sign flag doesn't get ;; overwritten before the CALL! - (inst test x #.(ash lowtag-mask (- n-word-bits n-fixnum-tag-bits 1))) + (inst test x #.(ash lowtag-mask n-positive-fixnum-bits)) ;; Faster but bigger then SHL Y 2. The cost of doing this speculatively ;; is noise compared to bignum consing if that is needed. - (inst lea y (make-ea :dword :index x :scale 4)) + (inst lea y (make-ea :dword :index x :scale (ash 1 n-fixnum-tag-bits))) (inst jmp :z done) (inst mov y x) (inst call (make-fixup (ecase (tn-offset y) diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index c00907e..9b66ca0 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -44,7 +44,7 @@ (inst jmp :ne done) ;; Pick off fixnums. - (inst and al-tn 3) + (inst and al-tn fixnum-tag-mask) (inst jmp :e done) ;; must be an other immediate @@ -142,7 +142,7 @@ (:results (res :scs (any-reg descriptor-reg) :from (:argument 0))) (:generator 2 (move res val) - (inst shl res (- n-widetag-bits 2)) + (inst shl res (- n-widetag-bits n-fixnum-tag-bits)) (inst or res (sc-case type (unsigned-reg type) (immediate (tn-value type)))))) diff --git a/version.lisp-expr b/version.lisp-expr index 54195fe..77ae1d3 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.33.19" +"1.0.33.20"