+++ /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);
- }
-
projects / sbcl.git / commitdiff