0.9.5.34:

  * grab all_threads_lock for the duration of creating and linking a
    thread struct to avoid gc lossage (reinstated STATE_STARTING and
    recomplicated thread start vs gc interaction)
  * fixed thread creation test

diff --git a/NEWS b/NEWS
index 58b48dd..3a73f5b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,7 @@ changes in sbcl-0.9.6 relative to sbcl-0.9.5:
        next exiting thread, no need to gc to collect thread stacks anymore
     ** minor incompatible change: INTERRUPT-THREAD-ERROR-ERRNO removed
     ** WITH-RECURSIVE-LOCK can be nested in a WITH-MUTEX for the same lock
+    ** bug fix: dynamic variable and thread start related gc lossage
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** SUBTYPEP is slightly more accurate on heinously complicated
        CONS types where some of the members have uncertain (in the

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 08ea191..5df9968 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -631,7 +631,6 @@ SB-EXT:QUIT - the usual cleanup forms will be evaluated"
      (let ((os-thread (sap-ref-word thread-sap
                                     (* sb!vm:n-word-bytes
                                        sb!vm::thread-os-thread-slot))))
-       (print os-thread)
        (when (= os-thread id) (return thread-sap))
        (setf thread-sap
              (sap-ref-sap thread-sap (* sb!vm:n-word-bytes

diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index 5ac22cb..7ab3fc8 100644 (file)
--- a/src/compiler/generic/objdef.lisp
+++ b/src/compiler/generic/objdef.lisp
@@ -407,7 +407,7 @@
   ;; tls[0] = NO_TLS_VALUE_MARKER_WIDETAG because a the tls index slot
   ;; of a symbol is initialized to zero
   (no-tls-value-marker)
-  (os-thread :c-type "os_thread_t")
+  (os-thread :c-type "volatile os_thread_t")
   (binding-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1)
   (binding-stack-pointer :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1)
   (control-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1)

diff --git a/src/runtime/thread.c b/src/runtime/thread.c
index 3614c80..c6d2ad5 100644 (file)
--- a/src/runtime/thread.c
+++ b/src/runtime/thread.c
@@ -41,6 +41,43 @@ extern int linux_no_threads_p;
 
 pthread_mutex_t all_threads_lock = PTHREAD_MUTEX_INITIALIZER;
 
+/* When trying to get all_threads_lock one should make sure that
+ * SIG_STOP_FOR_GC is not blocked. Else there would be a possible
+ * deadlock: gc locks it, other thread blocks signals, gc sends stop
+ * request to other thread and waits, other thread blocks on lock. */
+void check_sig_stop_for_gc_can_arrive_or_lose()
+{
+    /* Get the current sigmask, by blocking the empty set. */
+    sigset_t empty,current;
+    sigemptyset(&empty);
+    thread_sigmask(SIG_BLOCK, &empty, &current);
+    if (sigismember(&current,SIG_STOP_FOR_GC))
+        lose("SIG_STOP_FOR_GC cannot arrive: it is blocked\n");
+    if (SymbolValue(GC_INHIBIT,arch_os_get_current_thread()) != NIL)
+        lose("SIG_STOP_FOR_GC cannot arrive: gc is inhibited\n");
+    if (arch_pseudo_atomic_atomic(NULL))
+        lose("SIG_STOP_FOR_GC cannot arrive: in pseudo atomic\n");
+}
+
+#define GET_ALL_THREADS_LOCK(name) \
+    { \
+        sigset_t _newset,_oldset; \
+        sigemptyset(&_newset); \
+        sigaddset_deferrable(&_newset); \
+        thread_sigmask(SIG_BLOCK, &_newset, &_oldset); \
+        check_sig_stop_for_gc_can_arrive_or_lose(); \
+        FSHOW_SIGNAL((stderr,"/%s:waiting on lock=%ld, thread=%lu\n",name, \
+               all_threads_lock,arch_os_get_current_thread()->os_thread)); \
+        pthread_mutex_lock(&all_threads_lock); \
+        FSHOW_SIGNAL((stderr,"/%s:got lock, thread=%lu\n", \
+               name,arch_os_get_current_thread()->os_thread));
+
+#define RELEASE_ALL_THREADS_LOCK(name) \
+        FSHOW_SIGNAL((stderr,"/%s:released lock\n",name)); \
+        pthread_mutex_unlock(&all_threads_lock); \
+        thread_sigmask(SIG_SETMASK,&_oldset,0); \
+    }
+
 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 extern lispobj call_into_lisp_first_time(lispobj fun, lispobj *args, int nargs);
 #endif
@@ -50,12 +87,10 @@ extern lispobj call_into_lisp_first_time(lispobj fun, lispobj *args, int nargs);
 static void
 link_thread(struct thread *th)
 {
-    th->os_thread=thread_self();
     if (all_threads) all_threads->prev=th;
     th->next=all_threads;
     th->prev=0;
     all_threads=th;
-    protect_control_stack_guard_page(1);
 }
 
 #ifdef LISP_FEATURE_SB_THREAD
@@ -82,6 +117,9 @@ initial_thread_trampoline(struct thread *th)
     th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
     if(arch_os_thread_init(th)==0) return 1;
     link_thread(th);
+    th->os_thread=thread_self();
+    protect_control_stack_guard_page(1);
+    th->state = STATE_RUNNING;
 
 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     return call_into_lisp_first_time(function,args,0);
@@ -140,12 +178,23 @@ new_thread_trampoline(struct thread *th)
         lose("arch_os_thread_init failed\n");
     }
 
-    /* Since GC can only know about this thread from the all_threads
-     * list and we're just adding this thread to it there is no danger
-     * of deadlocking even with SIG_STOP_FOR_GC blocked. */
+    th->os_thread=thread_self();
+    protect_control_stack_guard_page(1);
+    /* This thread is in STATE_STARTING so the GC is not sending it
+     * SIG_STOP_FOR_GC => no danger of deadlocking even with
+     * SIG_STOP_FOR_GC blocked. The lock is acquired in order not to
+     * enter running state with the gc running. */
     pthread_mutex_lock(&all_threads_lock);
-    link_thread(th);
+    th->state = STATE_RUNNING;
     pthread_mutex_unlock(&all_threads_lock);
+    /* Now that we entered STATE_RUNNING let the gc suspend this
+     * thread. */
+    {
+        sigset_t sigset;
+        sigemptyset(&sigset);
+        sigaddset(&sigset, SIG_STOP_FOR_GC);
+        thread_sigmask(SIG_UNBLOCK, &sigset, 0);
+    }
 
     result = funcall0(function);
     th->state=STATE_DEAD;
@@ -243,7 +292,7 @@ create_thread_struct(lispobj initial_function) {
     th->binding_stack_pointer=th->binding_stack_start;
     th->this=th;
     th->os_thread=0;
-    th->state=STATE_RUNNING;
+    th->state=STATE_STARTING;
 #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
     th->alien_stack_pointer=((void *)th->alien_stack_start
                              + ALIEN_STACK_SIZE-N_WORD_BYTES);
@@ -321,10 +370,7 @@ boolean create_os_thread(struct thread *th,os_thread_t *kid_tid)
     sigset_t newset,oldset;
     boolean r=1;
     sigemptyset(&newset);
-    /* Blocking deferrable signals is enough, no need to block
-     * SIG_STOP_FOR_GC because the child process is not linked onto
-     * all_threads until it's ready. */
-    sigaddset_deferrable(&newset);
+    sigaddset_blockable(&newset);
     thread_sigmask(SIG_BLOCK, &newset, &oldset);
 
     if((pthread_attr_init(&attr)) ||
@@ -343,12 +389,23 @@ os_thread_t create_thread(lispobj initial_function) {
 
     if(linux_no_threads_p) return 0;
 
-    th=create_thread_struct(initial_function);
+    /* The new thread must be linked immediately onto all_threads for
+     * gc. */
+    GET_ALL_THREADS_LOCK("create_thread")
+    /* If it is too slow most of the allocation/initialization can
+     * be done without the lock. */
+    th = create_thread_struct(initial_function);
+    if (th)
+        link_thread(th);
+    RELEASE_ALL_THREADS_LOCK("create_thread")
     if(th==0) return 0;
 
     if (create_os_thread(th,&kid_tid)) {
         return kid_tid;
     } else {
+        GET_ALL_THREADS_LOCK("create_thread")
+        unlink_thread(th);
+        RELEASE_ALL_THREADS_LOCK("create_thread")
         free_thread_struct(th);
         return 0;
     }
@@ -425,12 +482,11 @@ void gc_stop_the_world()
     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:signals sent\n"));
     /* wait for the running threads to stop or finish */
     for(p=all_threads;p;) {
-        gc_assert(p->os_thread!=0);
-        if((p==th) || (p->state==STATE_SUSPENDED) ||
-           (p->state==STATE_DEAD)) {
-            p=p->next;
-        } else {
+        if((p!=th) && (p->state==STATE_RUNNING)) {
+            gc_assert(p->os_thread!=0);
             sched_yield();
+        } else {
+            p=p->next;
         }
     }
     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:end\n"));
@@ -446,8 +502,8 @@ void gc_start_the_world()
      * restarting */
     FSHOW_SIGNAL((stderr,"/gc_start_the_world:begin\n"));
     for(p=all_threads;p;p=p->next) {
-        gc_assert(p->os_thread!=0);
-        if((p!=th) && (p->state!=STATE_DEAD)) {
+        if((p!=th) && (p->state!=STATE_STARTING) && (p->state!=STATE_DEAD)) {
+            gc_assert(p->os_thread!=0);
             if(p->state!=STATE_SUSPENDED) {
                 lose("gc_start_the_world: wrong thread state is %d\n",
                      fixnum_value(p->state));

diff --git a/src/runtime/thread.h b/src/runtime/thread.h
index 37325b8..3f823cc 100644 (file)
--- a/src/runtime/thread.h
+++ b/src/runtime/thread.h
@@ -18,6 +18,7 @@ struct alloc_region { };
 #include "genesis/static-symbols.h"
 #include "genesis/thread.h"
 
+#define STATE_STARTING (make_fixnum(0))
 #define STATE_RUNNING (make_fixnum(1))
 #define STATE_SUSPENDED (make_fixnum(2))
 #define STATE_DEAD (make_fixnum(3))

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index cc47f12..d3cc162 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -179,7 +179,7 @@
              (let ((me *current-thread*))
                (dotimes (i 100)
                  (with-mutex (mutex)
-                   (sleep .1)
+                   (sleep .03)
                    (assert (eql (mutex-value mutex) me)))
                  (assert (not (eql (mutex-value mutex) me))))
                (format t "done ~A~%" *current-thread*))))
@@ -463,9 +463,10 @@
 
 (format t "~&session lock test done~%")
 
-(wait-for-threads
- (loop for i below 2000 collect
-       (sb-thread:make-thread (lambda ()))))
+(loop repeat 20 do
+      (wait-for-threads
+       (loop for i below 100 collect
+             (sb-thread:make-thread (lambda ())))))
 
 (format t "~&creation test done~%")
 
@@ -485,6 +486,21 @@
  (lambda ()
    (sb-ext:run-program "sleep" '("1") :search t :wait nil)))
 
+(with-test (:name (:thread-start :dynamic-values-and-gc))
+  (let ((gc-thread (sb-thread:make-thread (lambda ()
+                                            (loop (sleep (random 0.2))
+                                                  (sb-ext:gc :full t))))))
+    (wait-for-threads
+     (loop for i below 3000
+           when (zerop (mod i 30))
+           do (princ ".")
+           collect
+           (let ((*x* (lambda ())))
+             (declare (special *x*))
+             (sb-thread:make-thread (lambda () (functionp *x*))))))
+    (sb-thread:terminate-thread gc-thread)
+    (terpri)))
+
 #|  ;; a cll post from eric marsden
 | (defun crash ()
 |   (setq *debugger-hook*

diff --git a/version.lisp-expr b/version.lisp-expr
index c1489cd..043ac68 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.33"
+"0.9.5.34"