From 50e9f0e58a3b863085dc05845bfc6f5dbf82cdf2 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 19 Jun 2004 20:07:22 +0000 Subject: [PATCH] 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... --- NEWS | 3 +++ src/code/target-thread.lisp | 15 +++++++++------ version.lisp-expr | 2 +- 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/NEWS b/NEWS index 534ea29..0b1c2ba 100644 --- 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 --- 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 --- 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" -- 1.7.10.4