From: Alastair Bridgewater Date: Sun, 9 Oct 2011 21:06:28 +0000 (-0400) Subject: More unboxed-byte-addresses-are-word-addresses damage. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=357b030149015c45e007797517a8461924bb8c88;p=sbcl.git More unboxed-byte-addresses-are-word-addresses damage. * In the binding stack tests, the binding stack pointer is altered by adding two to SB-VM::*BINDING-STACK-POINTER*. This "works" when n-fixnum-tag-bits is equal to word-shift, but is badly wrong when they differ. * Fixed by adding a variable to hold the actual delta required, based on the difference between n-fixnum-tag-bits and word-shift. * Incidentally, how on earth does this test work on threaded PPC? PPC has the BSP in a register, not a variable, and there are no memory barriers around the synchronization for GCs. How does the (incf sb-vm::*binding-stack-pointer*) not die from an unbound symbol? And, really, it looks like it doesn't matter if a thread dies or lands in the debugger: If the process doesn't die screaming, the test always passes, even if it only does a single GC. * And, while we're on the topic, how on earth does this test work on x86? The memory-barrier argument should apply there as well. Wait, I know! The CPU still gets timer interrupts, and the kernel effectively provides a barrier then. And the "it doesn't matter" argument also applies here: If it doesn't deadlock the system completely, the main thread will kill everything off and call it a success after four seconds anyway. --- diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index 3dc340d..794ae61 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -852,11 +852,12 @@ ;; now SOMETHING is gc'ed and the binding stack looks like this: 0, ;; 0, SOMETHING, 0 (because the symbol slots are zeroed on ;; unbinding but values are not). - (let ((*x* nil)) + (let ((*x* nil) + (binding-pointer-delta (ash 2 (- sb-vm:word-shift sb-vm:n-fixnum-tag-bits)))) ;; bump bsp as if a BIND had just started - (incf sb-vm::*binding-stack-pointer* 2) + (incf sb-vm::*binding-stack-pointer* binding-pointer-delta) (wait-for-gc) - (decf sb-vm::*binding-stack-pointer* 2)))) + (decf sb-vm::*binding-stack-pointer* binding-pointer-delta)))) (with-test (:name (:binding-stack-gc-safety)) (let (threads)