0.9.5.43:

  * binding *CURRENT-THREAD* to NIL when interrupts are enabled is
    asking for trouble

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index 09d8653..c6acf9d 100644 (file)
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -100,7 +100,16 @@
 (defun sigint-%break (format-string &rest format-arguments)
   (flet ((break-it ()
            (apply #'%break 'sigint format-string format-arguments)))
-    (sb!thread:interrupt-thread (sb!thread::foreground-thread) #'break-it)))
+    (let ((done-p nil))
+      (loop while (not done-p)
+            do
+            (setq done-p t)
+            ;; what if I type interrupt-thread at the debugger?
+            (handler-case
+                (sb!thread:interrupt-thread (sb!thread::foreground-thread)
+                                            #'break-it)
+              (sb!thread:interrupt-thread-error ()
+                (setq done-p nil)))))))
 
 (eval-when (:compile-toplevel :execute)
   (sb!xc:defmacro define-signal-handler (name

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 7ca853f..42e0530 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -550,12 +550,9 @@ returns the thread exits."
                         (handle-thread-exit thread)))))))
             (values))))
     (let ((os-thread
-           ;; don't let the child inherit *CURRENT-THREAD* because that
-           ;; can prevent gc'ing this thread while the child runs
-           (let ((*current-thread* nil))
-             (with-pinned-objects (initial-function)
-               (%create-thread
-                (sb!kernel:get-lisp-obj-address initial-function))))))
+           (with-pinned-objects (initial-function)
+             (%create-thread
+              (sb!kernel:get-lisp-obj-address initial-function)))))
       (when (zerop os-thread)
         (error "Can't create a new thread"))
       (wait-on-semaphore setup-sem)

diff --git a/src/runtime/thread.h b/src/runtime/thread.h
index 9e0bd15..2815abd 100644 (file)
--- a/src/runtime/thread.h
+++ b/src/runtime/thread.h
@@ -42,7 +42,8 @@ extern int dynamic_values_bytes;
 #define for_each_thread(th) for(th=all_threads;th;th=0)
 #endif
 
-static inline lispobj SymbolValue(u64 tagged_symbol_pointer, void *thread) {
+static inline lispobj
+SymbolValue(u64 tagged_symbol_pointer, void *thread) {
     struct symbol *sym= (struct symbol *)
         (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG);
 #ifdef LISP_FEATURE_SB_THREAD
@@ -55,7 +56,9 @@ static inline lispobj SymbolValue(u64 tagged_symbol_pointer, void *thread) {
 #endif
     return sym->value;
 }
-static inline lispobj SymbolTlValue(u64 tagged_symbol_pointer, void *thread) {
+
+static inline lispobj
+SymbolTlValue(u64 tagged_symbol_pointer, void *thread) {
     struct symbol *sym= (struct symbol *)
         (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG);
 #ifdef LISP_FEATURE_SB_THREAD
@@ -66,7 +69,8 @@ static inline lispobj SymbolTlValue(u64 tagged_symbol_pointer, void *thread) {
 #endif
 }
 
-static inline void SetSymbolValue(u64 tagged_symbol_pointer,lispobj val, void *thread) {
+static inline void
+SetSymbolValue(u64 tagged_symbol_pointer,lispobj val, void *thread) {
     struct symbol *sym= (struct symbol *)
         (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG);
 #ifdef LISP_FEATURE_SB_THREAD
@@ -81,7 +85,8 @@ static inline void SetSymbolValue(u64 tagged_symbol_pointer,lispobj val, void *t
 #endif
     sym->value = val;
 }
-static inline void SetTlSymbolValue(u64 tagged_symbol_pointer,lispobj val, void *thread) {
+static inline void
+SetTlSymbolValue(u64 tagged_symbol_pointer,lispobj val, void *thread) {
 #ifdef LISP_FEATURE_SB_THREAD
     struct symbol *sym= (struct symbol *)
         (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG);
@@ -93,7 +98,8 @@ static inline void SetTlSymbolValue(u64 tagged_symbol_pointer,lispobj val, void
 #endif
 }
 
-static inline os_context_t *get_interrupt_context_for_thread(struct thread *th)
+static inline
+os_context_t *get_interrupt_context_for_thread(struct thread *th)
 {
     return th->interrupt_contexts
         [fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th)-1)];

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index d3cc162..4c45258 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -488,16 +488,31 @@
 
 (with-test (:name (:thread-start :dynamic-values-and-gc))
   (let ((gc-thread (sb-thread:make-thread (lambda ()
-                                            (loop (sleep (random 0.2))
+                                            (loop (sleep (random 0.01))
                                                   (sb-ext:gc :full t))))))
     (wait-for-threads
-     (loop for i below 3000
+     (loop for i below 30000000
            when (zerop (mod i 30))
-           do (princ ".")
+           do (princ ".") (force-output)
            collect
-           (let ((*x* (lambda ())))
-             (declare (special *x*))
-             (sb-thread:make-thread (lambda () (functionp *x*))))))
+           (let ((*a* (lambda ()))
+                 (*b* (lambda ()))
+                 (*c* (lambda ()))
+                 (*d* (lambda ()))
+                 (*e* (lambda ()))
+                 (*f* (lambda ()))
+                 (*g* (lambda ()))
+                 (*h* (lambda ())))
+             (declare (special *a* *b* *c* *d* *e* *f* *g* *h*))
+             (sb-thread:make-thread (lambda ()
+                                      (functionp *a*)
+                                      (functionp *b*)
+                                      (functionp *c*)
+                                      (functionp *d*)
+                                      (functionp *e*)
+                                      (functionp *f*)
+                                      (functionp *g*)
+                                      (functionp *h*))))))
     (sb-thread:terminate-thread gc-thread)
     (terpri)))
 

diff --git a/version.lisp-expr b/version.lisp-expr
index d24046b..3a5d164 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.9.5.42"
+"0.9.5.43"