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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)))))
 
 \f

diff --git a/src/compiler/ppc/alloc.lisp b/src/compiler/ppc/alloc.lisp
index d2b5a2a..58d9547 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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)))
 \f
 ;;; 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 (file)
--- 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 (file)
--- 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)))))
 
 \f

diff --git a/src/compiler/ppc/type-vops.lisp b/src/compiler/ppc/type-vops.lisp
index 4e46b6d..712d4de 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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)))))
 
 \f

diff --git a/src/compiler/sparc/type-vops.lisp b/src/compiler/sparc/type-vops.lisp
index 960ce71..9c6fdb8 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"