60 |
XXX - more overview here. |
XXX - more overview here. |
61 |
*/ |
*/ |
62 |
|
|
63 |
/* All data is protected by a single mutex: guile_mutex. */ |
/* All data (except the ready queue) is protected by a single mutex: |
64 |
|
guile_mutex. */ |
65 |
|
|
66 |
static pthread_mutex_t guile_mutex = PTHREAD_MUTEX_INITIALIZER; |
static pthread_mutex_t guile_mutex = PTHREAD_MUTEX_INITIALIZER; |
67 |
|
|
106 |
scm_copt_thread *t = SCM_THREAD_DATA(thread); |
scm_copt_thread *t = SCM_THREAD_DATA(thread); |
107 |
t->root = r; |
t->root = r; |
108 |
t->pthread = th; |
t->pthread = th; |
109 |
|
t->base = NULL; |
110 |
pthread_cond_init (&t->sleep_cond, NULL); |
pthread_cond_init (&t->sleep_cond, NULL); |
111 |
|
#if 0 |
112 |
|
fprintf (stderr, "%ld created %ld\n", pthread_self (), th); |
113 |
|
#endif |
114 |
} |
} |
115 |
|
|
116 |
static void |
static void |
125 |
thread_mark (SCM obj) |
thread_mark (SCM obj) |
126 |
{ |
{ |
127 |
scm_copt_thread *t = SCM_THREAD_DATA (obj); |
scm_copt_thread *t = SCM_THREAD_DATA (obj); |
128 |
|
#if 0 |
129 |
|
fprintf (stderr, "marking %ld\n", t->pthread); |
130 |
|
#endif |
131 |
scm_gc_mark (t->result); |
scm_gc_mark (t->result); |
132 |
return t->root->handle; |
return t->root->handle; |
133 |
} |
} |
153 |
thread_free (SCM obj) |
thread_free (SCM obj) |
154 |
{ |
{ |
155 |
scm_copt_thread *t = SCM_THREAD_DATA (obj); |
scm_copt_thread *t = SCM_THREAD_DATA (obj); |
156 |
|
#if 0 |
157 |
|
fprintf (stderr, "freeing %ld\n", t->pthread); |
158 |
|
#endif |
159 |
if (t->pthread != -1) |
if (t->pthread != -1) |
160 |
abort (); |
abort (); |
161 |
scm_gc_free (t, sizeof (*t), "thread"); |
scm_gc_free (t, sizeof (*t), "thread"); |
196 |
} |
} |
197 |
} |
} |
198 |
|
|
199 |
/*** Ready queue */ |
/*** Scheduling */ |
200 |
|
|
201 |
|
/* When a thread wants to execute Guile functions, it locks the |
202 |
|
guile_mutex. Since that is not necessarily fair, we put a layer on |
203 |
|
top so that only one or a few threads actually compete for that |
204 |
|
mutex. |
205 |
|
|
206 |
|
There is a global ready_queue with threads that want the |
207 |
|
guile_mutex. When a thread gives up its mutex, it dequeues one |
208 |
|
thread from the ready_queue and signals its condition variable. |
209 |
|
|
210 |
|
To enter Guile, a thread first tries to lock the guile_mutex and |
211 |
|
when that succeeds it has entered. Otherwise, it puts itself on |
212 |
|
the ready_queue and waits for its condition variable. |
213 |
|
*/ |
214 |
|
|
215 |
/* Normally, queues are implemented with the procedures above, but the |
/* Normally, queues are implemented with the procedures above, but the |
216 |
ready queue is special. We need to put threads on it from the |
ready queue is special. We need to put threads on it from the |
219 |
objects. |
objects. |
220 |
*/ |
*/ |
221 |
|
|
222 |
|
static SCM cur_thread; |
223 |
|
|
224 |
static pthread_mutex_t ready_queue_mutex = PTHREAD_MUTEX_INITIALIZER; |
static pthread_mutex_t ready_queue_mutex = PTHREAD_MUTEX_INITIALIZER; |
225 |
static scm_copt_thread *next_ready = NULL; |
static scm_copt_thread *next_ready = NULL; |
226 |
static scm_copt_thread *last_ready = NULL; |
static scm_copt_thread *last_ready = NULL; |
227 |
|
|
228 |
static void |
static void |
229 |
get_ready (scm_copt_thread *t) |
dump_ready_queue (void) |
230 |
|
{ |
231 |
|
#if 0 |
232 |
|
scm_copt_thread *t; |
233 |
|
fprintf (stderr, "ready queue:"); |
234 |
|
for (t = next_ready; t; t = t->next_ready) |
235 |
|
{ |
236 |
|
fprintf (stderr, " %ld", t->pthread); |
237 |
|
if (t == last_ready) |
238 |
|
fprintf (stderr, "."); |
239 |
|
} |
240 |
|
fprintf (stderr, "\n"); |
241 |
|
#endif |
242 |
|
} |
243 |
|
|
244 |
|
static void |
245 |
|
put_on_ready_queue_locked (scm_copt_thread *t) |
246 |
{ |
{ |
247 |
pthread_mutex_lock (&ready_queue_mutex); |
pthread_mutex_lock (&ready_queue_mutex); |
248 |
t->next_ready = NULL; |
t->next_ready = NULL; |
251 |
else |
else |
252 |
next_ready = t; |
next_ready = t; |
253 |
last_ready = t; |
last_ready = t; |
|
pthread_mutex_unlock (&ready_queue_mutex); |
|
254 |
} |
} |
255 |
|
|
256 |
static scm_copt_thread * |
static void |
257 |
get_next_ready () |
put_on_ready_queue (scm_copt_thread *t) |
258 |
{ |
{ |
259 |
scm_copt_thread *t; |
put_on_ready_queue_locked (t); |
|
pthread_mutex_lock (&ready_queue_mutex); |
|
|
t = next_ready; |
|
|
if (t) |
|
|
{ |
|
|
next_ready = t->next_ready; |
|
|
if (next_ready == NULL) |
|
|
last_ready = NULL; |
|
|
} |
|
|
return t; |
|
260 |
pthread_mutex_unlock (&ready_queue_mutex); |
pthread_mutex_unlock (&ready_queue_mutex); |
261 |
} |
} |
262 |
|
|
|
/*** Running and sleeping */ |
|
|
|
|
|
static SCM cur_thread; |
|
|
|
|
|
/* Kick the next runnable thread if there is one. |
|
|
*/ |
|
263 |
static void |
static void |
264 |
kick_next () |
enter_guile (scm_copt_thread *t) |
265 |
{ |
{ |
266 |
scm_copt_thread *next = get_next_ready (ready_queue); |
if (pthread_mutex_trylock (&guile_mutex) == EBUSY) |
267 |
if (next) |
{ |
268 |
pthread_cond_signal (&next->sleep_cond); |
put_on_ready_queue_locked (t); |
269 |
|
#if 0 |
270 |
|
fprintf (stderr, "%ld entering\n", pthread_self ()); |
271 |
|
#endif |
272 |
|
dump_ready_queue (); |
273 |
|
pthread_cond_wait (&t->sleep_cond, &ready_queue_mutex); |
274 |
|
pthread_mutex_unlock (&ready_queue_mutex); |
275 |
|
pthread_mutex_lock (&guile_mutex); |
276 |
|
} |
277 |
|
#if 0 |
278 |
|
fprintf (stderr, "%ld is in\n", pthread_self ()); |
279 |
|
#endif |
280 |
|
cur_thread = t->handle; |
281 |
|
t->top = NULL; |
282 |
} |
} |
283 |
|
|
284 |
static SCM |
static scm_copt_thread * |
285 |
suspend () |
leave_guile () |
286 |
{ |
{ |
287 |
SCM cur = cur_thread; |
SCM cur = cur_thread; |
288 |
scm_copt_thread *c = SCM_THREAD_DATA (cur); |
scm_copt_thread *c = SCM_THREAD_DATA (cur); |
293 |
SCM_FLUSH_REGISTER_WINDOWS; |
SCM_FLUSH_REGISTER_WINDOWS; |
294 |
setjmp (c->regs); |
setjmp (c->regs); |
295 |
|
|
296 |
return cur; |
#if 0 |
297 |
} |
fprintf (stderr, "%ld leaving\n", pthread_self ()); |
298 |
|
#endif |
299 |
|
|
300 |
|
if (next_ready) |
301 |
|
{ |
302 |
|
/* next_ready will never become NULL expect here. Thus, we |
303 |
|
don't need to test again after getting the mutex. |
304 |
|
*/ |
305 |
|
scm_copt_thread *n = next_ready; |
306 |
|
pthread_mutex_lock (&ready_queue_mutex); |
307 |
|
dump_ready_queue (); |
308 |
|
next_ready = n->next_ready; |
309 |
|
if (next_ready == NULL) |
310 |
|
last_ready = NULL; |
311 |
|
pthread_mutex_unlock (&ready_queue_mutex); |
312 |
|
#if 0 |
313 |
|
fprintf (stderr, "%ld kicking %ld\n", pthread_self (), n->pthread); |
314 |
|
#endif |
315 |
|
pthread_cond_signal (&n->sleep_cond); |
316 |
|
} |
317 |
|
|
|
static void |
|
|
release () |
|
|
{ |
|
318 |
pthread_mutex_unlock (&guile_mutex); |
pthread_mutex_unlock (&guile_mutex); |
|
} |
|
319 |
|
|
320 |
static void |
return c; |
|
acquire () |
|
|
{ |
|
|
please = 1; |
|
|
pthread_mutex_lock (&guile_mutex); |
|
321 |
} |
} |
322 |
|
|
323 |
static void |
static void |
324 |
resume (SCM cur) |
block () |
325 |
{ |
{ |
326 |
|
SCM cur = cur_thread; |
327 |
scm_copt_thread *c = SCM_THREAD_DATA (cur); |
scm_copt_thread *c = SCM_THREAD_DATA (cur); |
328 |
|
|
329 |
|
/* record top of stack for the GC */ |
330 |
|
c->top = (SCM_STACKITEM *)&c; |
331 |
|
/* save registers. */ |
332 |
|
SCM_FLUSH_REGISTER_WINDOWS; |
333 |
|
setjmp (c->regs); |
334 |
|
|
335 |
|
#if 0 |
336 |
|
fprintf (stderr, "%ld blocking\n", pthread_self ()); |
337 |
|
#endif |
338 |
|
|
339 |
|
if (next_ready) |
340 |
|
{ |
341 |
|
/* next_ready will never become NULL expect here. Thus, we |
342 |
|
don't need to test again after getting the mutex. |
343 |
|
*/ |
344 |
|
scm_copt_thread *n = next_ready; |
345 |
|
pthread_mutex_lock (&ready_queue_mutex); |
346 |
|
dump_ready_queue (); |
347 |
|
next_ready = n->next_ready; |
348 |
|
if (next_ready == NULL) |
349 |
|
last_ready = NULL; |
350 |
|
pthread_mutex_unlock (&ready_queue_mutex); |
351 |
|
#if 0 |
352 |
|
fprintf (stderr, "%ld kicking %ld\n", pthread_self (), n->pthread); |
353 |
|
#endif |
354 |
|
pthread_cond_signal (&n->sleep_cond); |
355 |
|
} |
356 |
|
|
357 |
|
pthread_cond_wait (&c->sleep_cond, &guile_mutex); |
358 |
|
|
359 |
|
#if 0 |
360 |
|
fprintf (stderr, "%ld is back\n", pthread_self ()); |
361 |
|
#endif |
362 |
cur_thread = cur; |
cur_thread = cur; |
363 |
c->top = NULL; |
c->top = NULL; |
364 |
} |
} |
365 |
|
|
366 |
static void |
int scm_switch_counter; |
|
block () |
|
|
{ |
|
|
SCM cur = suspend (); |
|
|
scm_copt_thread *c = SCM_THREAD_DATA (cur); |
|
|
pthread_cond_wait (&c->sleep_cond, &guile_mutex); |
|
|
resume (cur); |
|
|
} |
|
367 |
|
|
|
/* Yielding consists of getting the next thread from the ready_queue |
|
|
and if there is one, putting ourselves on the ready queue and |
|
|
block. |
|
|
*/ |
|
368 |
SCM |
SCM |
369 |
scm_yield () |
scm_yield () |
370 |
{ |
{ |
371 |
scm_copt_thread *next = get_next_ready (); |
if (next_ready) |
|
if (next) |
|
372 |
{ |
{ |
373 |
pthread_cond_signal (&next->sleep_cond); |
put_on_ready_queue (SCM_THREAD_DATA (cur_thread)); |
|
get_ready (SCM_THREAD_DATA (cur_thread)); |
|
374 |
block (); |
block (); |
375 |
} |
} |
376 |
return SCM_BOOL_T; |
return SCM_BOOL_T; |
377 |
} |
} |
378 |
|
|
|
int scm_switch_counter; |
|
379 |
|
|
380 |
/*** Thread creation */ |
/*** Thread creation */ |
381 |
|
|
408 |
{ |
{ |
409 |
scm_copt_thread *t = SCM_THREAD_DATA (thread); |
scm_copt_thread *t = SCM_THREAD_DATA (thread); |
410 |
scheme_launch_data data; |
scheme_launch_data data; |
411 |
|
enter_guile (t); |
412 |
init_thread_creatant (thread, base); |
init_thread_creatant (thread, base); |
|
resume (thread); |
|
413 |
|
|
414 |
/* Ok, we bullied our way in, now be nice and stand in queue. |
#if 0 |
415 |
*/ |
fprintf (stderr, "%ld is ready\n", pthread_self ()); |
416 |
scm_yield (); |
#endif |
417 |
|
|
418 |
data.rootcont = SCM_BOOL_F; |
data.rootcont = SCM_BOOL_F; |
419 |
data.body = SCM_CAR (t->result); |
data.body = SCM_CAR (t->result); |
425 |
&data, base); |
&data, base); |
426 |
pthread_detach (t->pthread); |
pthread_detach (t->pthread); |
427 |
|
|
|
{ |
|
|
SCM next = dequeue (ready_queue); |
|
|
if (!SCM_FALSEP (next)) |
|
|
{ |
|
|
scm_copt_thread *n = SCM_THREAD_DATA (next); |
|
|
pthread_cond_signal (&n->sleep_cond); |
|
|
} |
|
|
} |
|
|
|
|
428 |
all_threads = scm_delq (thread, all_threads); |
all_threads = scm_delq (thread, all_threads); |
429 |
t->pthread = -1; |
t->pthread = -1; |
430 |
thread_count--; |
thread_count--; |
431 |
suspend (); |
leave_guile (); |
432 |
} |
} |
433 |
|
|
434 |
static void * |
static void * |
435 |
scheme_launch_thread (void *p) |
scheme_launch_thread (void *p) |
436 |
{ |
{ |
|
acquire (); |
|
437 |
really_launch ((SCM_STACKITEM *)&p, (SCM)p); |
really_launch ((SCM_STACKITEM *)&p, (SCM)p); |
|
release (); |
|
438 |
return NULL; |
return NULL; |
439 |
} |
} |
440 |
|
|
556 |
while (m->owner != cur_thread) |
while (m->owner != cur_thread) |
557 |
{ |
{ |
558 |
enqueue (m->waiting, cur_thread); |
enqueue (m->waiting, cur_thread); |
|
kick_next (); |
|
559 |
block (); |
block (); |
560 |
SCM_ASYNC_TICK; |
SCM_ASYNC_TICK; |
561 |
} |
} |
587 |
if (!SCM_FALSEP (next)) |
if (!SCM_FALSEP (next)) |
588 |
{ |
{ |
589 |
m->owner = next; |
m->owner = next; |
590 |
enqueue (ready_queue, next); |
put_on_ready_queue (SCM_THREAD_DATA (next)); |
591 |
scm_yield (); |
scm_yield (); |
592 |
} |
} |
593 |
else |
else |
608 |
|
|
609 |
scm_switch_counter = SCM_THREAD_SWITCH_COUNT; |
scm_switch_counter = SCM_THREAD_SWITCH_COUNT; |
610 |
|
|
|
acquire (); |
|
611 |
cur_thread = make_thread (SCM_BOOL_F); |
cur_thread = make_thread (SCM_BOOL_F); |
612 |
|
enter_guile (SCM_THREAD_DATA (cur_thread)); |
613 |
/* root is set later from init.c */ |
/* root is set later from init.c */ |
614 |
init_thread_creator (cur_thread, pthread_self(), NULL); |
init_thread_creator (cur_thread, pthread_self(), NULL); |
615 |
init_thread_creatant (cur_thread, base); |
init_thread_creatant (cur_thread, base); |
616 |
resume (cur_thread); |
|
617 |
thread_count = 1; |
thread_count = 1; |
618 |
scm_gc_register_root (&all_threads); |
scm_gc_register_root (&all_threads); |
619 |
all_threads = scm_cons (cur_thread, SCM_EOL); |
all_threads = scm_cons (cur_thread, SCM_EOL); |
623 |
scm_set_smob_free (scm_tc16_thread, thread_free); |
scm_set_smob_free (scm_tc16_thread, thread_free); |
624 |
|
|
625 |
scm_set_smob_mark (scm_tc16_mutex, mutex_mark); |
scm_set_smob_mark (scm_tc16_mutex, mutex_mark); |
|
|
|
|
ready_queue = scm_permanent_object (make_queue ()); |
|
626 |
} |
} |
627 |
|
|
628 |
/*** Marking stacks */ |
/*** Marking stacks */ |
735 |
struct timeval *timeout) |
struct timeval *timeout) |
736 |
{ |
{ |
737 |
int res; |
int res; |
738 |
SCM cur = suspend (); |
scm_copt_thread *c = leave_guile (); |
|
release (); |
|
739 |
res = select (nfds, readfds, writefds, exceptfds, timeout); |
res = select (nfds, readfds, writefds, exceptfds, timeout); |
740 |
acquire (); |
enter_guile (c); |
|
resume (cur); |
|
741 |
SCM_ASYNC_TICK; |
SCM_ASYNC_TICK; |
742 |
return res; |
return res; |
743 |
} |
} |
955 |
unsigned long |
unsigned long |
956 |
scm_thread_usleep (unsigned long usec) |
scm_thread_usleep (unsigned long usec) |
957 |
{ |
{ |
958 |
return usleep (usec); |
usleep (usec); |
959 |
|
return 0; |
960 |
} |
} |
961 |
|
|
962 |
unsigned long |
unsigned long |