Introduce sb!vm::fixnum-lowtags

  * This is defined as a list of the exported SB!VM -LOWTAG symbols
bound to integers that are zero when masked with fixnum-tag-mask (in
short, the names of the fixnum lowtags).

  * Replace all direct references to the fixnum lowtags with something
based on fixnum-lowtags.

  * Introduce the corresponding change to genesis, with the predicate
is-fixnum-lowtag instead of testing against specific lowtags.

  * Introduce the corresponding change to the runtime, making fixnump()
check against fixnum-tag-mask instead of comparing individual fixnum
tags.

  * And, while we're redefining fixnump() in terms of the significant
part of the lowtag, do the same with other_immediate_lowtag_p().

diff --git a/src/code/class.lisp b/src/code/class.lisp
index 38fbef0..b9283ee 100644 (file)
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -1114,7 +1114,7 @@
       :translation (integer #.sb!xc:most-negative-fixnum
                     #.sb!xc:most-positive-fixnum)
       :inherits (integer rational real number)
-      :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag)
+      :codes #.(mapcar #'symbol-value sb!vm::fixnum-lowtags)
       :prototype-form 42)
      (bignum
       :translation (and integer (not fixnum))

diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp
index 550a515..2b78f6b 100644 (file)
--- a/src/compiler/generic/early-objdef.lisp
+++ b/src/compiler/generic/early-objdef.lisp
@@ -68,6 +68,20 @@
 (def!constant nil-value
     (+ static-space-start n-word-bytes other-pointer-lowtag))
 
+(defconstant-eqx fixnum-lowtags
+    #.(let ((fixtags nil))
+        (do-external-symbols (sym "SB!VM")
+          (let* ((name (symbol-name sym))
+                 (len (length name)))
+            (when (and (boundp sym)
+                       (integerp (symbol-value sym))
+                       (> len 7)
+                       (string= name "-LOWTAG" :start1 (- len 7))
+                       (zerop (logand (symbol-value sym) fixnum-tag-mask)))
+              (push sym fixtags))))
+        `',fixtags)
+  #'equal)
+
 ;;; the heap types, stored in 8 bits of the header of an object on the
 ;;; heap, to identify the type of the heap object (which'll be at
 ;;; least two machine words, often more)

diff --git a/src/compiler/generic/early-type-vops.lisp b/src/compiler/generic/early-type-vops.lisp
index 7709680..b84493d 100644 (file)
--- a/src/compiler/generic/early-type-vops.lisp
+++ b/src/compiler/generic/early-type-vops.lisp
@@ -48,8 +48,9 @@
                      &key &allow-other-keys)
   ;; Determine what interesting combinations we need to test for.
   (let* ((type-codes (mapcar #'eval type-codes))
-         (fixnump (and (member even-fixnum-lowtag type-codes)
-                       (member odd-fixnum-lowtag type-codes)
+         (fixnump (and (every (lambda (lowtag)
+                                (member lowtag type-codes))
+                              '#.(mapcar #'symbol-value fixnum-lowtags))
                        t))
          (lowtags (remove lowtag-limit type-codes :test #'<))
          (extended (remove lowtag-limit type-codes :test #'>))
@@ -66,8 +67,7 @@
     (cond
       (fixnump
        (when (remove-if (lambda (x)
-                          (or (= x even-fixnum-lowtag)
-                              (= x odd-fixnum-lowtag)))
+                          (member x '#.(mapcar #'symbol-value fixnum-lowtags)))
                         lowtags)
          (error "can't mix fixnum testing with other lowtags"))
        (when function-p

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index 511943f..9203077 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -279,6 +279,9 @@
 \f
 ;;;; representation of descriptors
 
+(defun is-fixnum-lowtag (lowtag)
+  (zerop (logand lowtag sb!vm:fixnum-tag-mask)))
+
 (defstruct (descriptor
             (:constructor make-descriptor
                           (high low &optional gspace word-offset))
@@ -300,8 +303,7 @@
 (def!method print-object ((des descriptor) stream)
   (let ((lowtag (descriptor-lowtag des)))
     (print-unreadable-object (des stream :type t)
-      (cond ((or (= lowtag sb!vm:even-fixnum-lowtag)
-                 (= lowtag sb!vm:odd-fixnum-lowtag))
+      (cond ((is-fixnum-lowtag lowtag)
              (let ((unsigned (logior (ash (descriptor-high des)
                                           (1+ (- descriptor-low-bits
                                                  sb!vm:n-lowtag-bits)))
@@ -387,8 +389,7 @@
   ;; Extract an (unsigned-byte 32), from either its fixnum or bignum
   ;; representation.
   (let ((lowtag (descriptor-lowtag des)))
-    (if (or (= lowtag sb!vm:even-fixnum-lowtag)
-            (= lowtag sb!vm:odd-fixnum-lowtag))
+    (if (is-fixnum-lowtag lowtag)
         (make-random-descriptor (descriptor-fixnum des))
         (read-wordindexed des 1))))
 
@@ -2301,8 +2302,7 @@ core and return a descriptor to it."
     (let ((total-elements 1))
       (dotimes (axis rank)
         (let ((dim (pop-stack)))
-          (unless (or (= (descriptor-lowtag dim) sb!vm:even-fixnum-lowtag)
-                      (= (descriptor-lowtag dim) sb!vm:odd-fixnum-lowtag))
+          (unless (is-fixnum-lowtag (descriptor-lowtag dim))
             (error "non-fixnum dimension? (~S)" dim))
           (setf total-elements
                 (* total-elements

diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp
index 2774689..418c634 100644 (file)
--- a/src/compiler/generic/late-type-vops.lisp
+++ b/src/compiler/generic/late-type-vops.lisp
@@ -11,7 +11,7 @@
 (in-package "SB!VM")
 \f
 (!define-type-vops fixnump check-fixnum fixnum object-not-fixnum-error
-  (even-fixnum-lowtag odd-fixnum-lowtag)
+  #.fixnum-lowtags
   ;; we can save a register on the x86.
   :variant simple
   ;; we can save a couple of instructions and a branch on the ppc.
@@ -191,9 +191,7 @@
               (coerce *specialized-array-element-type-properties* 'list)))))
 
 (!define-type-vops numberp check-number nil object-not-number-error
-  (even-fixnum-lowtag
-   odd-fixnum-lowtag
-   bignum-widetag
+  (bignum-widetag
    ratio-widetag
    single-float-widetag
    double-float-widetag
@@ -201,22 +199,22 @@
    complex-widetag
    complex-single-float-widetag
    complex-double-float-widetag
-   #!+long-float complex-long-float-widetag))
+   #!+long-float complex-long-float-widetag
+   . #.fixnum-lowtags))
 
 (!define-type-vops rationalp check-rational nil object-not-rational-error
-  (even-fixnum-lowtag odd-fixnum-lowtag ratio-widetag bignum-widetag))
+  (ratio-widetag bignum-widetag . #.fixnum-lowtags))
 
 (!define-type-vops integerp check-integer nil object-not-integer-error
-  (even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag))
+  (bignum-widetag . #.fixnum-lowtags))
 
 (!define-type-vops floatp check-float nil object-not-float-error
   (single-float-widetag double-float-widetag #!+long-float long-float-widetag))
 
 (!define-type-vops realp check-real nil object-not-real-error
-  (even-fixnum-lowtag
-   odd-fixnum-lowtag
-   ratio-widetag
+  (ratio-widetag
    bignum-widetag
    single-float-widetag
    double-float-widetag
-   #!+long-float long-float-widetag))
+   #!+long-float long-float-widetag
+   . #.fixnum-lowtags))

diff --git a/src/runtime/fixnump.h b/src/runtime/fixnump.h
index 9681520..756e2ea 100644 (file)
--- a/src/runtime/fixnump.h
+++ b/src/runtime/fixnump.h
@@ -14,10 +14,7 @@
 
 static inline int fixnump(lispobj obj)
 {
-    return((obj &
-            (LOWTAG_MASK &
-             (~(EVEN_FIXNUM_LOWTAG|ODD_FIXNUM_LOWTAG))))
-           == 0);
+    return((obj & FIXNUM_TAG_MASK) == 0);
 }
 
 #endif

diff --git a/src/runtime/runtime.h b/src/runtime/runtime.h
index de83bc8..65c2e48 100644 (file)
--- a/src/runtime/runtime.h
+++ b/src/runtime/runtime.h
@@ -232,19 +232,8 @@ typedef int boolean;
 static inline boolean
 other_immediate_lowtag_p(lispobj header)
 {
-    switch (lowtag_of(header)) {
-    case OTHER_IMMEDIATE_0_LOWTAG:
-    case OTHER_IMMEDIATE_1_LOWTAG:
-#ifdef OTHER_IMMEDIATE_2_LOWTAG
-    case OTHER_IMMEDIATE_2_LOWTAG:
-#endif
-#ifdef OTHER_IMMEDIATE_3_LOWTAG
-    case OTHER_IMMEDIATE_3_LOWTAG:
-#endif
-        return 1;
-    default:
-        return 0;
-    }
+    /* These lowtags are spaced 4 apart throughout the lowtag space. */
+    return (lowtag_of(header) & 3) == OTHER_IMMEDIATE_0_LOWTAG;
 }
 
 /* KLUDGE: As far as I can tell there's no ANSI C way of saying