0.8.11.18:

	Fix bug in INTERRUPT-THREAD
	... pin the function so it can't be moved by GC;
	... not /entirely/ clear why it's necessary, but...

diff --git a/NEWS b/NEWS
index 534ea29..0b1c2ba 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2543,6 +2543,9 @@ changes in sbcl-0.8.12 relative to sbcl-0.8.11:
   * fixed another bug in backquote printing: no more destructive
     modification of the form's list structure.  (reported by Brian
     Downing)
+  * fixed bug in INTERRUPT-THREAD: pin the function, so that it cannot
+    move between its address being taken and the call to
+    interrupt_thread, fixing a crashing race condition.
   * the SB-POSIX contrib implementation has been adjusted so that it
     no longer exhibits ridiculously poor performance when constructing
     instances corresponding to C structs.

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index b681336..69860df 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -300,12 +300,15 @@ time we reacquire LOCK and return to the caller."
 ;;; though, it's a good deal gentler than the last-resort functions above
 
 (defun interrupt-thread (thread function)
-  "Interrupt THREAD and make it run FUNCTION.  "
-  (sb!unix::syscall* ("interrupt_thread"
-                     sb!alien:unsigned-long  sb!alien:unsigned-long)
-                    thread
-                    thread (sb!kernel:get-lisp-obj-address
-                            (coerce function 'function))))
+  "Interrupt THREAD and make it run FUNCTION."
+  (let ((function (coerce function 'function)))
+    (sb!sys:with-pinned-objects (function)
+      (sb!unix::syscall* ("interrupt_thread"
+                         sb!alien:unsigned-long  sb!alien:unsigned-long)
+                        thread
+                        thread 
+                        (sb!kernel:get-lisp-obj-address function)))))
+
 (defun terminate-thread (thread-id)
   "Terminate the thread identified by THREAD-ID, by causing it to run
 SB-EXT:QUIT - the usual cleanup forms will be evaluated"

diff --git a/version.lisp-expr b/version.lisp-expr
index 020294c..5a77931 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.11.17"
+"0.8.11.18"