The branch "master" has been updated in SBCL:
via 7e02fe01f102c9e536df701dc783149a8d76b3fc (commit)
from a53e74a650cf42012d8c66835e450acdf73c23d6 (commit)
- Log -----------------------------------------------------------------
commit 7e02fe01f102c9e536df701dc783149a8d76b3fc
Author: Alastair Bridgewater <nyef_sbcl@...>
Date: Sun Feb 14 11:30:50 2010 -0500
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.
---
src/code/bit-bash.lisp | 26 ++++++++++++++++----------
src/code/debug-int.lisp | 6 ++++--
src/compiler/generic/genesis.lisp | 14 +++++++-------
src/compiler/generic/utils.lisp | 2 +-
src/runtime/alloc.c | 8 ++++----
src/runtime/breakpoint.c | 2 +-
6 files changed, 33 insertions(+), 25 deletions(-)
diff --git a/src/code/bit-bash.lisp b/src/code/bit-bash.lisp
index 17d0e1e..cb54b81 100644
--- 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))
@@ -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
--- 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)
- (o
|