| blob | 1634225aea01016e570d3eb0733fb9fed4189e6f |
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
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"))
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))
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
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 }