From: Nathan Froyd <froydnj@cs.rice.edu>
Date: Tue, 3 Aug 2004 17:28:47 +0000 (+0000)
Subject: 0.8.13.20:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b192aee93a1e81f5cdac019daf42bcfa55109757;p=sbcl.git

0.8.13.20:
	LESS MAGIC NUMBERS (and LESS GRAMMAR)
	... removed a fair number of numeric constants from alpha support
	    files, replacing them with their symbolic equivalents from
	    generic/early-vm.lisp.  probably haven't rooted out all of
	    the offenders, but it's a start.
---

diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp
index 83c8f0b..186d062 100644
--- a/src/compiler/alpha/arith.lisp
+++ b/src/compiler/alpha/arith.lisp
@@ -353,7 +353,7 @@
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:translate *)
   (:generator 4
-    (inst sra y 2 temp)
+    (inst sra y n-fixnum-tag-bits temp)
     (inst mulq x temp r)))
 
 (define-vop (fast-*/signed=>signed fast-signed-binop)
@@ -788,7 +788,7 @@
   (:results (digit :scs (unsigned-reg)))
   (:result-types unsigned-num)
   (:generator 1
-    (inst sra fixnum 2 digit)))
+    (inst sra fixnum n-fixnum-tag-bits digit)))
 
 (define-vop (bignum-floor)
   (:translate sb!bignum:%floor)
diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp
index 38572a3..67ecea0 100644
--- a/src/compiler/alpha/array.lisp
+++ b/src/compiler/alpha/array.lisp
@@ -31,7 +31,7 @@
     (inst addq rank (fixnumize (1- array-dimensions-offset)) header)
     (inst sll header n-widetag-bits header)
     (inst bis header type header)
-    (inst srl header 2 header)
+    (inst srl header n-fixnum-tag-bits header)
     (pseudo-atomic ()
       (inst bis alloc-tn other-pointer-lowtag result)
       (storew header result 0 other-pointer-lowtag)
@@ -58,7 +58,7 @@
     (loadw temp x 0 other-pointer-lowtag)
     (inst sra temp n-widetag-bits temp)
     (inst subq temp (1- array-dimensions-offset) temp)
-    (inst sll temp 2 res)))
+    (inst sll temp n-fixnum-tag-bits res)))
 
 ;;;; bounds checking routine
 
@@ -128,7 +128,7 @@
 				temp result)
                     (:generator 20
                                 (inst srl index ,bit-shift temp)
-                                (inst sll temp 2 temp)
+                                (inst sll temp n-fixnum-tag-bits temp)
                                 (inst addq object temp lip)
                                 (inst ldl result
                                       (- (* vector-data-offset n-word-bytes)
@@ -140,7 +140,7 @@
 					    ,(1- (integer-length bits)) temp)))
                                 (inst srl result temp result)
                                 (inst and result ,(1- (ash 1 bits)) result)
-                                (inst sll result 2 value)))
+                                (inst sll result n-fixnum-tag-bits value)))
                   (define-vop (,(symbolicate 'data-vector-ref-c/ type))
                     (:translate data-vector-ref)
                     (:policy :fast-safe)
@@ -184,7 +184,7 @@
 				      :from (:argument 1)) shift)
                     (:generator 25
                                 (inst srl index ,bit-shift temp)
-                                (inst sll temp 2 temp)
+                                (inst sll temp n-fixnum-tag-bits temp)
                                 (inst addq object temp lip)
                                 (inst ldl old
                                       (- (* vector-data-offset n-word-bytes)
diff --git a/src/compiler/alpha/char.lisp b/src/compiler/alpha/char.lisp
index 5c65b59..c4788f1 100644
--- a/src/compiler/alpha/char.lisp
+++ b/src/compiler/alpha/char.lisp
@@ -83,7 +83,7 @@
   (:results (res :scs (any-reg)))
   (:result-types positive-fixnum)
   (:generator 1
-    (inst sll ch 2 res)))
+    (inst sll ch n-fixnum-tag-bits res)))
 
 (define-vop (code-char)
   (:translate code-char)
@@ -93,7 +93,7 @@
   (:results (res :scs (base-char-reg)))
   (:result-types base-char)
   (:generator 1
-    (inst srl code 2 res)))
+    (inst srl code n-fixnum-tag-bits res)))
 
 ;;;; comparison of BASE-CHARs
 
diff --git a/src/compiler/alpha/move.lisp b/src/compiler/alpha/move.lisp
index ffe5885..a8b9a54 100644
--- a/src/compiler/alpha/move.lisp
+++ b/src/compiler/alpha/move.lisp
@@ -151,7 +151,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))
@@ -175,8 +175,8 @@
   (:temporary (:sc non-descriptor-reg) header)
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 3
-    (inst and x 3 temp)
-    (inst sra x 2 y)
+    (inst and x fixnum-tag-mask temp)
+    (inst sra x n-fixnum-tag-bits y)
     (inst beq temp done)
 
     (loadw header x 0 other-pointer-lowtag)
@@ -206,7 +206,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))
@@ -221,8 +221,8 @@
   (:note "signed word to integer coercion")
   (:generator 18
     (move arg x)
-    (inst sra x 29 temp)
-    (inst sll x 2 y)
+    (inst sra x n-positive-fixnum-bits temp)
+    (inst sll x n-fixnum-tag-bits y)
     (inst beq temp done)
     (inst not temp temp)
     (inst beq temp done)
@@ -258,8 +258,8 @@
   (:note "unsigned word to integer coercion")
   (:generator 20
     (move arg x)
-    (inst srl x 29 temp)
-    (inst sll x 2 y)
+    (inst srl x n-positive-fixnum-bits temp)
+    (inst sll x n-fixnum-tag-bits y)
     (inst beq temp done)
       
     (inst li 3 temp)
diff --git a/src/compiler/alpha/system.lisp b/src/compiler/alpha/system.lisp
index 5ee4202..a57b8b2 100644
--- a/src/compiler/alpha/system.lisp
+++ b/src/compiler/alpha/system.lisp
@@ -41,7 +41,7 @@
     (inst blbs object done)
 
     ;; Pick off fixnums.
-    (inst and object 3 result)
+    (inst and object fixnum-tag-mask result)
     (inst beq result done)
 
     ;; Must be an other immediate.
@@ -151,8 +151,8 @@
        (inst sll val n-widetag-bits temp)
        (inst bis temp (tn-value type) res))
       (t
-       (inst sra type 2 temp)
-       (inst sll val (- n-widetag-bits 2) res)
+       (inst sra type n-fixnum-tag-bits temp)
+       (inst sll val (- n-widetag-bits n-fixnum-tag-bits) res)
        (inst bis res temp res)))))
 
 
diff --git a/src/compiler/alpha/type-vops.lisp b/src/compiler/alpha/type-vops.lisp
index 57e015a..d8723b1 100644
--- a/src/compiler/alpha/type-vops.lisp
+++ b/src/compiler/alpha/type-vops.lisp
@@ -13,7 +13,7 @@
 
 (defun %test-fixnum (value target not-p &key temp)
   (assemble ()
-    (inst and value 3 temp)
+    (inst and value fixnum-tag-mask temp)
     (if not-p
         (inst bne temp target)
         (inst beq temp target))))
@@ -21,7 +21,7 @@
 (defun %test-fixnum-and-headers (value target not-p headers &key temp)
   (let ((drop-through (gen-label)))
     (assemble ()
-      (inst and value 3 temp)
+      (inst and value fixnum-tag-mask temp)
       (inst beq temp (if not-p drop-through target)))
     (%test-headers value target not-p nil headers
 		   :drop-through drop-through :temp temp)))
@@ -137,7 +137,7 @@
 	  (values not-target target)
 	  (values target not-target))
     (assemble ()
-      (inst and value 3 temp)
+      (inst and value fixnum-tag-mask temp)
       (inst beq temp yep)
       (inst and value lowtag-mask temp)
       (inst xor temp other-pointer-lowtag temp)
@@ -177,7 +177,7 @@
 			   (values target not-target))
     (assemble ()
       ;; Is it a fixnum?
-      (inst and value 3 temp1)
+      (inst and value fixnum-tag-mask temp1)
       (inst move value temp)
       (inst beq temp1 fixnum)
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 1222ad5..39daff2 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".)
-"0.8.13.19"
+"0.8.13.20"