X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=69860df5ae183be11243c88ce6744c55ec70c3d5;hb=8b64d57b865fec6ba082dda965146b5e8aa877b3;hp=b681336ec231a354c8373f316f48d0e25289fa17;hpb=ec066d84dd46611428943d152749b3891a3f4b7c;p=sbcl.git

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"