General disentwingling of fixnums and words.

  * Historically, n-fixnum-tag-bits has been equal to word-shift and has
been (1- n-lowtag-bits).  This led to implementors using constants and
calculations which happened to be right by coincidence rather than by
design.

  * Fix all places not part of the support for a particular backend to
use the defined-correct constants and calculations for the operations
being performed.

  * Thanks to Paul Khuong for helping with the finding and fixing of
many of these coincidences.

diff --git a/src/code/bit-bash.lisp b/src/code/bit-bash.lisp
index 17d0e1e..cb54b81 100644 (file)
--- a/src/code/bit-bash.lisp
+++ b/src/code/bit-bash.lisp
@@ -93,14 +93,14 @@
            (type index offset)
            (values sb!vm:word)
            (optimize (speed 3) (safety 0) #-sb-xc-host (inhibit-warnings 3)))
-  (sap-ref-word sap (the index (ash offset sb!vm:n-fixnum-tag-bits))))
+  (sap-ref-word sap (the index (ash offset sb!vm:word-shift))))
 (defun %set-word-sap-ref (sap offset value)
   (declare (type system-area-pointer sap)
            (type index offset)
            (type sb!vm:word value)
            (values sb!vm:word)
            (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
-  (setf (sap-ref-word sap (the index (ash offset sb!vm:n-fixnum-tag-bits)))
+  (setf (sap-ref-word sap (the index (ash offset sb!vm:word-shift)))
         value))
 
 \f
@@ -120,15 +120,21 @@
         (declare (type system-area-pointer sap)
                  (type index offset)
                  (values system-area-pointer index))
-        (let ((address (sap-int sap)))
-          (values (int-sap #!-alpha (word-logical-andc2 address
-                                                        sb!vm:fixnum-tag-mask)
-                           #!+alpha (ash (ash address -2) 2))
+        (let ((address (sap-int sap))
+              (word-mask (1- (ash 1 word-shift))))
+          (values (int-sap #!-alpha (word-logical-andc2 address word-mask)
+                           ;; KLUDGE: WORD-LOGICAL-ANDC2 is defined in
+                           ;; terms of n-word-bits.  On all systems
+                           ;; where n-word-bits is not equal to
+                           ;; n-machine-word-bits we have to do this
+                           ;; another way.  At this time, these
+                           ;; systems are alphas, though there was
+                           ;; some talk about an x86-64 build option.
+                           #!+alpha (ash (ash address (- word-shift)) word-shift))
                   (+ ,(ecase bitsize
-                       (1 '(* (logand address sb!vm:fixnum-tag-mask) n-byte-bits))
-                       (2 '(* (logand address sb!vm:fixnum-tag-mask) (/ n-byte-bits 2)))
-                       (4 '(* (logand address sb!vm:fixnum-tag-mask) (/ n-byte-bits 4)))
-                       ((8 16 32 64) '(logand address sb!vm:fixnum-tag-mask)))
+                       ((1 2 4) `(* (logand address word-mask)
+                                    (/ n-byte-bits ,bitsize)))
+                       ((8 16 32 64) '(logand address word-mask)))
                      offset)))))))
 
 ;;; We cheat a little bit by using TRULY-THE in the copying function to

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 9df9a29..ef48049 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -527,11 +527,13 @@
     #!-stack-grows-downward-not-upward
     (and (sap< x (current-sp))
          (sap<= control-stack-start x)
-         (or (not aligned) (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask))))
+         (or (not aligned) (zerop (logand (sap-int x)
+                                          (1- (ash 1 sb!vm:word-shift))))))
     #!+stack-grows-downward-not-upward
     (and (sap>= x (current-sp))
          (sap> control-stack-end x)
-         (or (not aligned) (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask))))))
+         (or (not aligned) (zerop (logand (sap-int x)
+                                          (1- (ash 1 sb!vm:word-shift))))))))
 
 (declaim (inline component-ptr-from-pc))
 (sb!alien:define-alien-routine component-ptr-from-pc (system-area-pointer)

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index 9203077..9dd2264 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -381,9 +381,9 @@
         ;; it's hard to see how it could have been wrong, since CMU CL
         ;; genesis worked. It would be nice to understand how this came
         ;; to be.. -- WHN 19990901
-        (logior (ash bits (- 1 sb!vm:n-lowtag-bits))
+        (logior (ash bits (- sb!vm:n-fixnum-tag-bits))
                 (ash -1 (1+ sb!vm:n-positive-fixnum-bits)))
-        (ash bits (- 1 sb!vm:n-lowtag-bits)))))
+        (ash bits (- sb!vm:n-fixnum-tag-bits)))))
 
 (defun descriptor-word-sized-integer (des)
   ;; Extract an (unsigned-byte 32), from either its fixnum or bignum
@@ -458,9 +458,9 @@
 
 (defun make-fixnum-descriptor (num)
   (when (>= (integer-length num)
-            (1+ (- sb!vm:n-word-bits sb!vm:n-lowtag-bits)))
+            (- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits))
     (error "~W is too big for a fixnum." num))
-  (make-random-descriptor (ash num (1- sb!vm:n-lowtag-bits))))
+  (make-random-descriptor (ash num sb!vm:n-fixnum-tag-bits)))
 
 (defun make-other-immediate-descriptor (data type)
   (make-descriptor (ash data (- sb!vm:n-widetag-bits descriptor-low-bits))
@@ -768,7 +768,7 @@ core and return a descriptor to it."
 (defun number-to-core (number)
   (typecase number
     (integer (if (< (integer-length number)
-                    (- (1+ sb!vm:n-word-bits) sb!vm:n-lowtag-bits))
+                    (- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits))
                  (make-fixnum-descriptor number)
                  (bignum-to-core number)))
     (ratio (number-pair-to-core (number-to-core (numerator number))
@@ -2308,9 +2308,9 @@ core and return a descriptor to it."
                 (* total-elements
                    (logior (ash (descriptor-high dim)
                                 (- descriptor-low-bits
-                                   (1- sb!vm:n-lowtag-bits)))
+                                   sb!vm:n-fixnum-tag-bits))
                            (ash (descriptor-low dim)
-                                (- 1 sb!vm:n-lowtag-bits)))))
+                                sb!vm:n-fixnum-tag-bits))))
           (write-wordindexed result
                              (+ sb!vm:array-dimensions-offset axis)
                              dim)))

diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
index 3625f66..d4192d3 100644 (file)
--- a/src/compiler/generic/utils.lisp
+++ b/src/compiler/generic/utils.lisp
@@ -15,7 +15,7 @@
 ;;; Make a fixnum out of NUM. (I.e. shift by two bits if it will fit.)
 (defun fixnumize (num)
   (if (fixnump num)
-      (ash num (1- n-lowtag-bits))
+      (ash num n-fixnum-tag-bits)
       (error "~W is too big for a fixnum." num)))
 
 ;;; Determining whether a constant offset fits in an addressing mode.

diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c
index 58c1798..f67ccd0 100644 (file)
--- a/src/runtime/alloc.c
+++ b/src/runtime/alloc.c
@@ -197,9 +197,9 @@ alloc_code_object (unsigned boxed, unsigned unboxed) {
     /* Coming in, boxed is the number of boxed words requested.
      * Converting it to a fixnum makes it measured in bytes. It's also
      * rounded up to double word along the way. */
-    boxed = make_fixnum(boxed + 1 +
-                        (offsetof(struct code, trace_table_offset) >>
-                         WORD_SHIFT));
+    boxed = (boxed + 1 +
+             (offsetof(struct code, trace_table_offset) >>
+              WORD_SHIFT)) << WORD_SHIFT;
     boxed &= ~LOWTAG_MASK;
 
     /* Unboxed is in bytes, round it up to double word boundary. Now
@@ -216,7 +216,7 @@ alloc_code_object (unsigned boxed, unsigned unboxed) {
         lose("alloc_code_object called with GC enabled.");
     boxed = boxed << (N_WIDETAG_BITS - WORD_SHIFT);
     code->header = boxed | CODE_HEADER_WIDETAG;
-    code->code_size = unboxed;
+    code->code_size = unboxed >> (WORD_SHIFT - N_FIXNUM_TAG_BITS);
     code->entry_points = NIL;
     code->debug_info = NIL;
     return make_lispobj(code, OTHER_POINTER_LOWTAG);

diff --git a/src/runtime/breakpoint.c b/src/runtime/breakpoint.c
index a325693..5cada3e 100644 (file)
--- a/src/runtime/breakpoint.c
+++ b/src/runtime/breakpoint.c
@@ -116,7 +116,7 @@ static long compute_offset(os_context_t *context, lispobj code)
             return 0;
         else {
             unsigned long offset = pc - code_start;
-            if (offset >= codeptr->code_size)
+            if (offset >= (N_WORD_BYTES * fixnum_value(codeptr->code_size)))
                 return 0;
             else
                 return make_fixnum(offset);