contrib/experimental-thread.patch

   1
   2 The attached changes are supposed to fix bugs in SBCL when used for
   3 gc-intensive multithreaded applications.  They haven't had sufficient
   4 testing to be commited in time for SBCL 0.8.5 (may even make things
   5 worse), but if you run into problems with deadlock or spinning on CPU,
   6 you may want to apply this and rebuild.    -dan 2003.10.23
   7
   8
   9
  10 Index: src/code/gc.lisp
  11 ===================================================================
  12 RCS file: /cvsroot/sbcl/sbcl/src/code/gc.lisp,v
  13 retrieving revision 1.52
  14 diff -u -r1.52 gc.lisp
  15 --- src/code/gc.lisp    2 Oct 2003 23:13:09 -0000       1.52
  16 +++ src/code/gc.lisp    23 Oct 2003 19:22:19 -0000
  17 @@ -236,22 +236,26 @@
  18  (defvar *already-in-gc* nil "System is running SUB-GC")
  19  (defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex"))
  20
  21 +
  22 +
  23  (defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
  24    ;; catch attempts to gc recursively or during post-hooks and ignore them
  25 -  (when (sb!thread::mutex-value *gc-mutex*)  (return-from sub-gc nil))
  26 -  (sb!thread:with-mutex (*gc-mutex* :wait-p nil)
  27 -    (setf *need-to-collect-garbage* t)
  28 -    (when (zerop *gc-inhibit*)
  29 -      (without-interrupts
  30 -       (gc-stop-the-world)
  31 -       (collect-garbage gen)
  32 -       (incf *n-bytes-freed-or-purified*
  33 -            (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
  34 -       (setf *need-to-collect-garbage* nil)
  35 -       (gc-start-the-world))
  36 -      (scrub-control-stack)
  37 -      (setf *need-to-collect-garbage* nil)
  38 -      (dolist (h *after-gc-hooks*) (carefully-funcall h))))
  39 +  (let ((value (sb!thread::mutex-value *gc-mutex*)))
  40 +    (when (eql value (sb!thread:current-thread-id)) (return-from sub-gc nil))
  41 +    (sb!thread:with-mutex (*gc-mutex*)
  42 +      (when value (return-from sub-gc nil))
  43 +      (setf *need-to-collect-garbage* t)
  44 +      (when (zerop *gc-inhibit*)
  45 +       (without-interrupts
  46 +        (gc-stop-the-world)
  47 +        (collect-garbage gen)
  48 +        (incf *n-bytes-freed-or-purified*
  49 +              (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
  50 +        (setf *need-to-collect-garbage* nil)
  51 +        (gc-start-the-world))
  52 +       (scrub-control-stack)
  53 +       (setf *need-to-collect-garbage* nil)
  54 +       (dolist (h *after-gc-hooks*) (carefully-funcall h)))))
  55    (values))
  56
  57
  58 Index: src/runtime/thread.c
  59 ===================================================================
  60 RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.c,v
  61 retrieving revision 1.18
  62 diff -u -r1.18 thread.c
  63 --- src/runtime/thread.c        7 Oct 2003 21:41:27 -0000       1.18
  64 +++ src/runtime/thread.c        23 Oct 2003 19:22:26 -0000
  65 @@ -53,6 +53,8 @@
  66         fprintf(stderr, "/continue\n");
  67      }
  68      th->unbound_marker = UNBOUND_MARKER_WIDETAG;
  69 +    if(arch_os_thread_init(th)==0)
  70 +       return 1;               /* failure.  no, really */
  71  #ifdef LISP_FEATURE_SB_THREAD
  72      /* wait here until our thread is linked into all_threads: see below */
  73      while(th->pid<1) sched_yield();
  74 @@ -61,8 +63,7 @@
  75         lose("th->pid not set up right");
  76  #endif
  77
  78 -    if(arch_os_thread_init(th)==0)
  79 -       return 1;               /* failure.  no, really */
  80 +    th->state=STATE_RUNNING;
  81  #if !defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_X86)
  82      return call_into_lisp_first_time(function,args,0);
  83  #else
  84 @@ -139,7 +140,7 @@
  85      th->binding_stack_pointer=th->binding_stack_start;
  86      th->this=th;
  87      th->pid=0;
  88 -    th->state=STATE_RUNNING;
  89 +    th->state=STATE_STOPPED;
  90  #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
  91      th->alien_stack_pointer=((void *)th->alien_stack_start
  92                              + ALIEN_STACK_SIZE-4); /* naked 4.  FIXME */
  93 @@ -312,39 +313,36 @@
  94  {
  95      /* stop all other threads by sending them SIG_STOP_FOR_GC */
  96      struct thread *p,*th=arch_os_get_current_thread();
  97 -    struct thread *tail=0;
  98 +    pid_t old_pid;
  99      int finished=0;
 100      do {
 101         get_spinlock(&all_threads_lock,th->pid);
 102 -       if(tail!=all_threads) {
 103 -           /* new threads always get consed onto the front of all_threads,
 104 -            * and may be created by any thread that we haven't signalled
 105 -            * yet or hasn't received our signal and stopped yet.  So, check
 106 -            * for them on each time around */
 107 -           for(p=all_threads;p!=tail;p=p->next) {
 108 -               if(p==th) continue;
 109 -               /* if the head of all_threads is removed during
 110 -                * gc_stop_the_world, we may take a second trip through the
 111 -                * list and end up counting twice as many threads to wait for
 112 -                * as actually exist */
 113 -               if(p->state!=STATE_RUNNING) continue;
 114 -               countdown_to_gc++;
 115 -               p->state=STATE_STOPPING;
 116 -               /* Note no return value check from kill().  If the
 117 -                * thread had been reaped already, we kill it and
 118 -                * increment countdown_to_gc anyway.  This is to avoid
 119 -                * complicating the logic in destroy_thread, which would
 120 -                * otherwise have to know whether the thread died before or
 121 -                * after it was killed
 122 -                */
 123 -               kill(p->pid,SIG_STOP_FOR_GC);
 124 -           }
 125 -           tail=all_threads;
 126 -       } else {
 127 -           finished=(countdown_to_gc==0);
 128 +       for(p=all_threads,old_pid=p->pid; p; p=p->next) {
 129 +           if(p==th) continue;
 130 +           if(p->state!=STATE_RUNNING) continue;
 131 +           countdown_to_gc++;
 132 +           p->state=STATE_STOPPING;
 133 +           /* Note no return value check from kill().  If the
 134 +            * thread had been reaped already, we kill it and
 135 +            * increment countdown_to_gc anyway.  This is to avoid
 136 +            * complicating the logic in destroy_thread, which would
 137 +            * otherwise have to know whether the thread died before or
 138 +            * after it was killed
 139 +            */
 140 +           kill(p->pid,SIG_STOP_FOR_GC);
 141         }
 142         release_spinlock(&all_threads_lock);
 143         sched_yield();
 144 +       /* if everything has stopped, and there is no possibility that
 145 +        * a new thread has been created, we're done.  Otherwise go
 146 +        * round again and signal anything that sprang up since last
 147 +        * time  */
 148 +       if(old_pid==all_threads->pid) {
 149 +           finished=1;
 150 +           for_each_thread(p)
 151 +               finished = finished &&
 152 +               ((p==th) || (p->state==STATE_STOPPED));
 153 +       }
 154      } while(!finished);
 155  }
 156