--- /dev/null
+
+The attached changes are supposed to fix bugs in SBCL when used for
+gc-intensive multithreaded applications. They haven't had sufficient
+testing to be commited in time for SBCL 0.8.5 (may even make things
+worse), but if you run into problems with deadlock or spinning on CPU,
+you may want to apply this and rebuild. -dan 2003.10.23
+
+
+
+Index: src/code/gc.lisp
+===================================================================
+RCS file: /cvsroot/sbcl/sbcl/src/code/gc.lisp,v
+retrieving revision 1.52
+diff -u -r1.52 gc.lisp
+--- src/code/gc.lisp 2 Oct 2003 23:13:09 -0000 1.52
++++ src/code/gc.lisp 23 Oct 2003 19:22:19 -0000
+@@ -236,22 +236,26 @@
+ (defvar *already-in-gc* nil "System is running SUB-GC")
+ (defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex"))
+
++
++
+ (defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
+ ;; catch attempts to gc recursively or during post-hooks and ignore them
+- (when (sb!thread::mutex-value *gc-mutex*) (return-from sub-gc nil))
+- (sb!thread:with-mutex (*gc-mutex* :wait-p nil)
+- (setf *need-to-collect-garbage* t)
+- (when (zerop *gc-inhibit*)
+- (without-interrupts
+- (gc-stop-the-world)
+- (collect-garbage gen)
+- (incf *n-bytes-freed-or-purified*
+- (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
+- (setf *need-to-collect-garbage* nil)
+- (gc-start-the-world))
+- (scrub-control-stack)
+- (setf *need-to-collect-garbage* nil)
+- (dolist (h *after-gc-hooks*) (carefully-funcall h))))
++ (let ((value (sb!thread::mutex-value *gc-mutex*)))
++ (when (eql value (sb!thread:current-thread-id)) (return-from sub-gc nil))
++ (sb!thread:with-mutex (*gc-mutex*)
++ (when value (return-from sub-gc nil))
++ (setf *need-to-collect-garbage* t)
++ (when (zerop *gc-inhibit*)
++ (without-interrupts
++ (gc-stop-the-world)
++ (collect-garbage gen)
++ (incf *n-bytes-freed-or-purified*
++ (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
++ (setf *need-to-collect-garbage* nil)
++ (gc-start-the-world))
++ (scrub-control-stack)
++ (setf *need-to-collect-garbage* nil)
++ (dolist (h *after-gc-hooks*) (carefully-funcall h)))))
+ (values))
+
+
+Index: src/runtime/thread.c
+===================================================================
+RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.c,v
+retrieving revision 1.18
+diff -u -r1.18 thread.c
+--- src/runtime/thread.c 7 Oct 2003 21:41:27 -0000 1.18
++++ src/runtime/thread.c 23 Oct 2003 19:22:26 -0000
+@@ -53,6 +53,8 @@
+ fprintf(stderr, "/continue\n");
+ }
+ th->unbound_marker = UNBOUND_MARKER_WIDETAG;
++ if(arch_os_thread_init(th)==0)
++ return 1; /* failure. no, really */
+ #ifdef LISP_FEATURE_SB_THREAD
+ /* wait here until our thread is linked into all_threads: see below */
+ while(th->pid<1) sched_yield();
+@@ -61,8 +63,7 @@
+ lose("th->pid not set up right");
+ #endif
+
+- if(arch_os_thread_init(th)==0)
+- return 1; /* failure. no, really */
++ th->state=STATE_RUNNING;
+ #if !defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_X86)
+ return call_into_lisp_first_time(function,args,0);
+ #else
+@@ -139,7 +140,7 @@
+ th->binding_stack_pointer=th->binding_stack_start;
+ th->this=th;
+ th->pid=0;
+- th->state=STATE_RUNNING;
++ th->state=STATE_STOPPED;
+ #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
+ th->alien_stack_pointer=((void *)th->alien_stack_start
+ + ALIEN_STACK_SIZE-4); /* naked 4. FIXME */
+@@ -312,39 +313,36 @@
+ {
+ /* stop all other threads by sending them SIG_STOP_FOR_GC */
+ struct thread *p,*th=arch_os_get_current_thread();
+- struct thread *tail=0;
++ pid_t old_pid;
+ int finished=0;
+ do {
+ get_spinlock(&all_threads_lock,th->pid);
+- if(tail!=all_threads) {
+- /* new threads always get consed onto the front of all_threads,
+- * and may be created by any thread that we haven't signalled
+- * yet or hasn't received our signal and stopped yet. So, check
+- * for them on each time around */
+- for(p=all_threads;p!=tail;p=p->next) {
+- if(p==th) continue;
+- /* if the head of all_threads is removed during
+- * gc_stop_the_world, we may take a second trip through the
+- * list and end up counting twice as many threads to wait for
+- * as actually exist */
+- if(p->state!=STATE_RUNNING) continue;
+- countdown_to_gc++;
+- p->state=STATE_STOPPING;
+- /* Note no return value check from kill(). If the
+- * thread had been reaped already, we kill it and
+- * increment countdown_to_gc anyway. This is to avoid
+- * complicating the logic in destroy_thread, which would
+- * otherwise have to know whether the thread died before or
+- * after it was killed
+- */
+- kill(p->pid,SIG_STOP_FOR_GC);
+- }
+- tail=all_threads;
+- } else {
+- finished=(countdown_to_gc==0);
++ for(p=all_threads,old_pid=p->pid; p; p=p->next) {
++ if(p==th) continue;
++ if(p->state!=STATE_RUNNING) continue;
++ countdown_to_gc++;
++ p->state=STATE_STOPPING;
++ /* Note no return value check from kill(). If the
++ * thread had been reaped already, we kill it and
++ * increment countdown_to_gc anyway. This is to avoid
++ * complicating the logic in destroy_thread, which would
++ * otherwise have to know whether the thread died before or
++ * after it was killed
++ */
++ kill(p->pid,SIG_STOP_FOR_GC);
+ }
+ release_spinlock(&all_threads_lock);
+ sched_yield();
++ /* if everything has stopped, and there is no possibility that
++ * a new thread has been created, we're done. Otherwise go
++ * round again and signal anything that sprang up since last
++ * time */
++ if(old_pid==all_threads->pid) {
++ finished=1;
++ for_each_thread(p)
++ finished = finished &&
++ ((p==th) || (p->state==STATE_STOPPED));
++ }
+ } while(!finished);
+ }
+
(defun unix-killpg (pgrp signal)
(real-unix-killpg pgrp signal))
-;;; Set the current set of masked signals (those being blocked from
+;;; Reset the current set of masked signals (those being blocked from
;;; delivery).
;;;
-;;; (Note: CMU CL had a SIGMASK operator to create masks, but since
-;;; SBCL only uses 0, we no longer support it. If you need it, you
-;;; can pull it out of the CMU CL sources, or the old SBCL sources;
-;;; but you might also consider doing things the SBCL way and moving
-;;; this kind of C-level work down to C wrapper functions.)
-#!-sunos
-(sb!alien:define-alien-routine ("sigsetmask" unix-sigsetmask)
- sb!alien:unsigned-long
- (mask sb!alien:unsigned-long))
+;;; (Note: CMU CL had a more general SIGSETMASK call and a SIGMASK
+;;; operator to create masks, but since we only ever reset to 0, we no
+;;; longer support it. If you need it, you can pull it out of the CMU
+;;; CL sources, or the old SBCL sources; but you might also consider
+;;; doing things the SBCL way and moving this kind of C-level work
+;;; down to C wrapper functions.)
+
+;;; When inappropriate build options are used, this also prints messages
+;;; listing the signals that were masked
+(sb!alien:define-alien-routine "reset_signal_mask" sb!alien:void)
\f
;;;; C routines that actually do all the work of establishing signal handlers
(sb!alien:define-alien-routine ("install_handler" install-handler)
sb!alien:unsigned-long
(signal sb!alien:int)
(handler sb!alien:unsigned-long))
-;;; assert (though non-fatally) that there are no signals masked
-(sb!alien:define-alien-routine "warn_when_signals_masked" sb!alien:void)
-
-\f
-
-
;;;; interface to enabling and disabling signal handlers
projects / sbcl.git / commitdiff