From: Alastair Bridgewater Date: Sun, 14 Feb 2010 15:39:18 +0000 (-0500) Subject: Introduce sb!vm::fixnum-lowtags X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f2942b56a5ed1b60b730b387ee2b9e40c8cc28fb;p=sbcl.git 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 --- 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 --- 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 --- 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 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -279,6 +279,9 @@ ;;;; 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 --- a/src/compiler/generic/late-type-vops.lisp +++ b/src/compiler/generic/late-type-vops.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") (!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 --- 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 --- 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