forked from dmitryvk/sbcl-win32-threads
-
Notifications
You must be signed in to change notification settings - Fork 4
/
experimental-thread.patch
156 lines (147 loc) · 5.67 KB
/
experimental-thread.patch
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
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);
}