1.0.2.7: Darwin/MacOS threading improvements
[sbcl.git] / src / runtime / thread.c
1 /*
2  * This software is part of the SBCL system. See the README file for
3  * more information.
4  *
5  * This software is derived from the CMU CL system, which was
6  * written at Carnegie Mellon University and released into the
7  * public domain. The software is in the public domain and is
8  * provided with absolutely no warranty. See the COPYING and CREDITS
9  * files for more information.
10  */
11
12 #include "sbcl.h"
13
14 #include <stdlib.h>
15 #include <stdio.h>
16 #include <string.h>
17 #ifndef LISP_FEATURE_WIN32
18 #include <sched.h>
19 #endif
20 #include <signal.h>
21 #include <stddef.h>
22 #include <errno.h>
23 #include <sys/types.h>
24 #ifndef LISP_FEATURE_WIN32
25 #include <sys/wait.h>
26 #endif
27
28 #ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
29 #include <mach/mach.h>
30 #include <mach/mach_error.h>
31 #include <mach/mach_types.h>
32 #endif
33
34 #include "runtime.h"
35 #include "validate.h"           /* for CONTROL_STACK_SIZE etc */
36 #include "alloc.h"
37 #include "thread.h"
38 #include "arch.h"
39 #include "target-arch-os.h"
40 #include "os.h"
41 #include "globals.h"
42 #include "dynbind.h"
43 #include "genesis/cons.h"
44 #include "genesis/fdefn.h"
45 #include "interr.h"             /* for lose() */
46 #include "gc-internal.h"
47
48 #ifdef LISP_FEATURE_WIN32
49 /*
50  * Win32 doesn't have SIGSTKSZ, and we're not switching stacks anyway,
51  * so define it arbitrarily
52  */
53 #define SIGSTKSZ 1024
54 #endif
55
56 #if defined(LISP_FEATURE_DARWIN) && defined(LISP_FEATURE_SB_THREAD)
57 #define QUEUE_FREEABLE_THREAD_STACKS
58 #define LOCK_CREATE_THREAD
59 #endif
60
61 #ifdef LISP_FEATURE_FREEBSD
62 #define CREATE_CLEANUP_THREAD
63 #define LOCK_CREATE_THREAD
64 #endif
65
66 #define ALIEN_STACK_SIZE (1*1024*1024) /* 1Mb size chosen at random */
67
68 struct freeable_stack {
69 #ifdef QUEUE_FREEABLE_THREAD_STACKS
70     struct freeable_stack *next;
71 #endif
72     os_thread_t os_thread;
73     os_vm_address_t stack;
74 };
75
76
77 #ifdef QUEUE_FREEABLE_THREAD_STACKS
78 static struct freeable_stack * volatile freeable_stack_queue = 0;
79 static int freeable_stack_count = 0;
80 pthread_mutex_t freeable_stack_lock = PTHREAD_MUTEX_INITIALIZER;
81 #else
82 static struct freeable_stack * volatile freeable_stack = 0;
83 #endif
84
85 int dynamic_values_bytes=4096*sizeof(lispobj);  /* same for all threads */
86 struct thread * volatile all_threads;
87 extern struct interrupt_data * global_interrupt_data;
88
89 #ifdef LISP_FEATURE_SB_THREAD
90 pthread_mutex_t all_threads_lock = PTHREAD_MUTEX_INITIALIZER;
91 #ifdef LOCK_CREATE_THREAD
92 static pthread_mutex_t create_thread_lock = PTHREAD_MUTEX_INITIALIZER;
93 #endif
94 #endif
95
96 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
97 extern lispobj call_into_lisp_first_time(lispobj fun, lispobj *args, int nargs);
98 #endif
99
100 static void
101 link_thread(struct thread *th)
102 {
103     if (all_threads) all_threads->prev=th;
104     th->next=all_threads;
105     th->prev=0;
106     all_threads=th;
107 }
108
109 #ifdef LISP_FEATURE_SB_THREAD
110 static void
111 unlink_thread(struct thread *th)
112 {
113     if (th->prev)
114         th->prev->next = th->next;
115     else
116         all_threads = th->next;
117     if (th->next)
118         th->next->prev = th->prev;
119 }
120 #endif
121
122 static int
123 initial_thread_trampoline(struct thread *th)
124 {
125     lispobj function;
126 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
127     lispobj *args = NULL;
128 #endif
129     function = th->no_tls_value_marker;
130     th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
131     if(arch_os_thread_init(th)==0) return 1;
132     link_thread(th);
133     th->os_thread=thread_self();
134 #ifndef LISP_FEATURE_WIN32
135     protect_control_stack_guard_page(1);
136 #endif
137
138 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
139     return call_into_lisp_first_time(function,args,0);
140 #else
141     return funcall0(function);
142 #endif
143 }
144
145 #define THREAD_STRUCT_SIZE (THREAD_CONTROL_STACK_SIZE + BINDING_STACK_SIZE + \
146                             ALIEN_STACK_SIZE + dynamic_values_bytes + \
147                             32 * SIGSTKSZ)
148
149 #ifdef LISP_FEATURE_SB_THREAD
150
151 #ifdef QUEUE_FREEABLE_THREAD_STACKS
152
153 static void
154 queue_freeable_thread_stack(struct thread *thread_to_be_cleaned_up)
155 {
156      if (thread_to_be_cleaned_up) {
157         pthread_mutex_lock(&freeable_stack_lock);
158         if (freeable_stack_queue) {
159             struct freeable_stack *new_freeable_stack = 0, *next;
160             next = freeable_stack_queue;
161             while (next->next) {
162                 next = next->next;
163             }
164             new_freeable_stack = (struct freeable_stack *)
165                 os_validate(0, sizeof(struct freeable_stack));
166             new_freeable_stack->next = NULL;
167             new_freeable_stack->os_thread = thread_to_be_cleaned_up->os_thread;
168             new_freeable_stack->stack = (os_vm_address_t)
169                 thread_to_be_cleaned_up->control_stack_start;
170             next->next = new_freeable_stack;
171             freeable_stack_count++;
172         } else {
173             struct freeable_stack *new_freeable_stack = 0;
174             new_freeable_stack = (struct freeable_stack *)
175                 os_validate(0, sizeof(struct freeable_stack));
176             new_freeable_stack->next = NULL;
177             new_freeable_stack->os_thread = thread_to_be_cleaned_up->os_thread;
178             new_freeable_stack->stack = (os_vm_address_t)
179                 thread_to_be_cleaned_up->control_stack_start;
180             freeable_stack_queue = new_freeable_stack;
181             freeable_stack_count++;
182         }
183         pthread_mutex_unlock(&freeable_stack_lock);
184     }
185 }
186
187 #define FREEABLE_STACK_QUEUE_SIZE 4
188
189 static void
190 free_freeable_stacks() {
191     if (freeable_stack_queue && (freeable_stack_count > FREEABLE_STACK_QUEUE_SIZE)) {
192         struct freeable_stack* old;
193         pthread_mutex_lock(&freeable_stack_lock);
194         old = freeable_stack_queue;
195         freeable_stack_queue = old->next;
196         freeable_stack_count--;
197         gc_assert(pthread_join(old->os_thread, NULL) == 0);
198         FSHOW((stderr, "freeing thread %x stack\n", old->os_thread));
199         os_invalidate(old->stack, THREAD_STRUCT_SIZE);
200         os_invalidate((os_vm_address_t)old, sizeof(struct freeable_stack));
201         pthread_mutex_unlock(&freeable_stack_lock);
202     }
203 }
204
205 #elif defined(CREATE_CLEANUP_THREAD)
206 static void *
207 cleanup_thread(void *arg)
208 {
209     struct freeable_stack *freeable = arg;
210     pthread_t self = pthread_self();
211
212     FSHOW((stderr, "/cleaner thread(%p): joining %p\n",
213            self, freeable->os_thread));
214     gc_assert(pthread_join(freeable->os_thread, NULL) == 0);
215     FSHOW((stderr, "/cleaner thread(%p): free stack %p\n",
216            self, freeable->stack));
217     os_invalidate(freeable->stack, THREAD_STRUCT_SIZE);
218     free(freeable);
219
220     pthread_detach(self);
221
222     return NULL;
223 }
224
225 static void
226 create_cleanup_thread(struct thread *thread_to_be_cleaned_up)
227 {
228     pthread_t thread;
229     int result;
230
231     if (thread_to_be_cleaned_up) {
232         struct freeable_stack *freeable =
233             malloc(sizeof(struct freeable_stack));
234         gc_assert(freeable != NULL);
235         freeable->os_thread = thread_to_be_cleaned_up->os_thread;
236         freeable->stack =
237             (os_vm_address_t) thread_to_be_cleaned_up->control_stack_start;
238         result = pthread_create(&thread, NULL, cleanup_thread, freeable);
239         gc_assert(result == 0);
240         sched_yield();
241     }
242 }
243
244 #else
245 static void
246 free_thread_stack_later(struct thread *thread_to_be_cleaned_up)
247 {
248     struct freeable_stack *new_freeable_stack = 0;
249     if (thread_to_be_cleaned_up) {
250         new_freeable_stack = (struct freeable_stack *)
251             os_validate(0, sizeof(struct freeable_stack));
252         new_freeable_stack->os_thread = thread_to_be_cleaned_up->os_thread;
253         new_freeable_stack->stack = (os_vm_address_t)
254             thread_to_be_cleaned_up->control_stack_start;
255     }
256     new_freeable_stack = (struct freeable_stack *)
257         swap_lispobjs((lispobj *)(void *)&freeable_stack,
258                       (lispobj)new_freeable_stack);
259     if (new_freeable_stack) {
260         FSHOW((stderr,"/reaping %p\n", (void*) new_freeable_stack->os_thread));
261         /* Under NPTL pthread_join really waits until the thread
262          * exists and the stack can be safely freed. This is sadly not
263          * mandated by the pthread spec. */
264         gc_assert(pthread_join(new_freeable_stack->os_thread, NULL) == 0);
265         os_invalidate(new_freeable_stack->stack, THREAD_STRUCT_SIZE);
266         os_invalidate((os_vm_address_t) new_freeable_stack,
267                       sizeof(struct freeable_stack));
268     }
269 }
270 #endif
271
272 /* this is the first thing that runs in the child (which is why the
273  * silly calling convention).  Basically it calls the user's requested
274  * lisp function after doing arch_os_thread_init and whatever other
275  * bookkeeping needs to be done
276  */
277 int
278 new_thread_trampoline(struct thread *th)
279 {
280     lispobj function;
281     int result, lock_ret;
282
283     FSHOW((stderr,"/creating thread %lu\n", thread_self()));
284     function = th->no_tls_value_marker;
285     th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
286     if(arch_os_thread_init(th)==0) {
287         /* FIXME: handle error */
288         lose("arch_os_thread_init failed\n");
289     }
290
291     th->os_thread=thread_self();
292     protect_control_stack_guard_page(1);
293     /* Since GC can only know about this thread from the all_threads
294      * list and we're just adding this thread to it there is no danger
295      * of deadlocking even with SIG_STOP_FOR_GC blocked (which it is
296      * not). */
297     lock_ret = pthread_mutex_lock(&all_threads_lock);
298     gc_assert(lock_ret == 0);
299     link_thread(th);
300     lock_ret = pthread_mutex_unlock(&all_threads_lock);
301     gc_assert(lock_ret == 0);
302
303     result = funcall0(function);
304
305     /* Block GC */
306     block_blockable_signals();
307     th->state=STATE_DEAD;
308
309     /* SIG_STOP_FOR_GC is blocked and GC might be waiting for this
310      * thread, but since we are already dead it won't wait long. */
311     lock_ret = pthread_mutex_lock(&all_threads_lock);
312     gc_assert(lock_ret == 0);
313
314     gc_alloc_update_page_tables(0, &th->alloc_region);
315     unlink_thread(th);
316     pthread_mutex_unlock(&all_threads_lock);
317     gc_assert(lock_ret == 0);
318
319     if(th->tls_cookie>=0) arch_os_thread_cleanup(th);
320     os_invalidate((os_vm_address_t)th->interrupt_data,
321                   (sizeof (struct interrupt_data)));
322
323 #ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
324     FSHOW((stderr, "Deallocating mach port %x\n", THREAD_STRUCT_TO_EXCEPTION_PORT(th)));
325     mach_port_move_member(mach_task_self(),
326                           THREAD_STRUCT_TO_EXCEPTION_PORT(th),
327                           MACH_PORT_NULL);
328     mach_port_deallocate(mach_task_self(),
329                          THREAD_STRUCT_TO_EXCEPTION_PORT(th));
330     mach_port_destroy(mach_task_self(),
331                       THREAD_STRUCT_TO_EXCEPTION_PORT(th));
332 #endif
333
334 #ifdef QUEUE_FREEABLE_THREAD_STACKS
335     queue_freeable_thread_stack(th);
336 #elif defined(CREATE_CLEANUP_THREAD)
337     create_cleanup_thread(th);
338 #else
339     free_thread_stack_later(th);
340 #endif
341
342     FSHOW((stderr,"/exiting thread %p\n", thread_self()));
343     return result;
344 }
345
346 #endif /* LISP_FEATURE_SB_THREAD */
347
348 static void
349 free_thread_struct(struct thread *th)
350 {
351     if (th->interrupt_data)
352         os_invalidate((os_vm_address_t) th->interrupt_data,
353                       (sizeof (struct interrupt_data)));
354     os_invalidate((os_vm_address_t) th->control_stack_start,
355                   THREAD_STRUCT_SIZE);
356 }
357
358 /* this is called from any other thread to create the new one, and
359  * initialize all parts of it that can be initialized from another
360  * thread
361  */
362
363 static struct thread *
364 create_thread_struct(lispobj initial_function) {
365     union per_thread_data *per_thread;
366     struct thread *th=0;        /*  subdue gcc */
367     void *spaces=0;
368 #ifdef LISP_FEATURE_SB_THREAD
369     int i;
370 #endif
371
372 #ifdef CREATE_CLEANUP_THREAD
373     /* Give a chance for cleanup threads to run. */
374     sched_yield();
375 #endif
376     /* may as well allocate all the spaces at once: it saves us from
377      * having to decide what to do if only some of the allocations
378      * succeed */
379     spaces=os_validate(0, THREAD_STRUCT_SIZE);
380     if(!spaces)
381          return NULL;
382     per_thread=(union per_thread_data *)
383         (spaces+
384          THREAD_CONTROL_STACK_SIZE+
385          BINDING_STACK_SIZE+
386          ALIEN_STACK_SIZE);
387
388 #ifdef LISP_FEATURE_SB_THREAD
389     for(i = 0; i < (dynamic_values_bytes / sizeof(lispobj)); i++)
390         per_thread->dynamic_values[i] = NO_TLS_VALUE_MARKER_WIDETAG;
391     if (all_threads == 0) {
392         if(SymbolValue(FREE_TLS_INDEX,0)==UNBOUND_MARKER_WIDETAG) {
393             SetSymbolValue
394                 (FREE_TLS_INDEX,
395                  /* FIXME: should be MAX_INTERRUPTS -1 ? */
396                  make_fixnum(MAX_INTERRUPTS+
397                              sizeof(struct thread)/sizeof(lispobj)),
398                  0);
399             SetSymbolValue(TLS_INDEX_LOCK,make_fixnum(0),0);
400         }
401 #define STATIC_TLS_INIT(sym,field) \
402   ((struct symbol *)(sym-OTHER_POINTER_LOWTAG))->tls_index= \
403   make_fixnum(THREAD_SLOT_OFFSET_WORDS(field))
404
405         STATIC_TLS_INIT(BINDING_STACK_START,binding_stack_start);
406         STATIC_TLS_INIT(BINDING_STACK_POINTER,binding_stack_pointer);
407         STATIC_TLS_INIT(CONTROL_STACK_START,control_stack_start);
408         STATIC_TLS_INIT(CONTROL_STACK_END,control_stack_end);
409         STATIC_TLS_INIT(ALIEN_STACK,alien_stack_pointer);
410 #if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64)
411         STATIC_TLS_INIT(PSEUDO_ATOMIC_BITS,pseudo_atomic_bits);
412 #endif
413 #undef STATIC_TLS_INIT
414     }
415 #endif
416
417     th=&per_thread->thread;
418     th->control_stack_start = spaces;
419     th->binding_stack_start=
420         (lispobj*)((void*)th->control_stack_start+THREAD_CONTROL_STACK_SIZE);
421     th->control_stack_end = th->binding_stack_start;
422     th->alien_stack_start=
423         (lispobj*)((void*)th->binding_stack_start+BINDING_STACK_SIZE);
424     th->binding_stack_pointer=th->binding_stack_start;
425     th->this=th;
426     th->os_thread=0;
427     th->state=STATE_RUNNING;
428 #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
429     th->alien_stack_pointer=((void *)th->alien_stack_start
430                              + ALIEN_STACK_SIZE-N_WORD_BYTES);
431 #else
432     th->alien_stack_pointer=((void *)th->alien_stack_start);
433 #endif
434 #if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64)
435     th->pseudo_atomic_bits=0;
436 #endif
437 #ifdef LISP_FEATURE_GENCGC
438     gc_set_region_empty(&th->alloc_region);
439 #endif
440
441 #ifndef LISP_FEATURE_SB_THREAD
442     /* the tls-points-into-struct-thread trick is only good for threaded
443      * sbcl, because unithread sbcl doesn't have tls.  So, we copy the
444      * appropriate values from struct thread here, and make sure that
445      * we use the appropriate SymbolValue macros to access any of the
446      * variable quantities from the C runtime.  It's not quite OAOOM,
447      * it just feels like it */
448     SetSymbolValue(BINDING_STACK_START,(lispobj)th->binding_stack_start,th);
449     SetSymbolValue(CONTROL_STACK_START,(lispobj)th->control_stack_start,th);
450     SetSymbolValue(CONTROL_STACK_END,(lispobj)th->control_stack_end,th);
451 #if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64)
452     SetSymbolValue(BINDING_STACK_POINTER,(lispobj)th->binding_stack_pointer,th);
453     SetSymbolValue(ALIEN_STACK,(lispobj)th->alien_stack_pointer,th);
454     SetSymbolValue(PSEUDO_ATOMIC_BITS,(lispobj)th->pseudo_atomic_bits,th);
455 #else
456     current_binding_stack_pointer=th->binding_stack_pointer;
457     current_control_stack_pointer=th->control_stack_start;
458 #endif
459 #endif
460     bind_variable(CURRENT_CATCH_BLOCK,make_fixnum(0),th);
461     bind_variable(CURRENT_UNWIND_PROTECT_BLOCK,make_fixnum(0),th);
462     bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,make_fixnum(0),th);
463     bind_variable(INTERRUPT_PENDING, NIL,th);
464     bind_variable(INTERRUPTS_ENABLED,T,th);
465     bind_variable(GC_PENDING,NIL,th);
466 #ifdef LISP_FEATURE_SB_THREAD
467     bind_variable(STOP_FOR_GC_PENDING,NIL,th);
468 #endif
469
470     th->interrupt_data = (struct interrupt_data *)
471         os_validate(0,(sizeof (struct interrupt_data)));
472     if (!th->interrupt_data) {
473         free_thread_struct(th);
474         return 0;
475     }
476     th->interrupt_data->pending_handler = 0;
477     th->no_tls_value_marker=initial_function;
478
479     th->stepping = NIL;
480     return th;
481 }
482
483 #ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
484 mach_port_t setup_mach_exception_handling_thread();
485 kern_return_t mach_thread_init(mach_port_t thread_exception_port);
486
487 #endif
488
489 void create_initial_thread(lispobj initial_function) {
490     struct thread *th=create_thread_struct(initial_function);
491     if(th) {
492 #ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
493         kern_return_t ret;
494
495         setup_mach_exception_handling_thread();
496 #endif
497         initial_thread_trampoline(th); /* no return */
498     } else lose("can't create initial thread\n");
499 }
500
501 #ifdef LISP_FEATURE_SB_THREAD
502
503 #ifndef __USE_XOPEN2K
504 extern int pthread_attr_setstack (pthread_attr_t *__attr, void *__stackaddr,
505                                   size_t __stacksize);
506 #endif
507
508 boolean create_os_thread(struct thread *th,os_thread_t *kid_tid)
509 {
510     /* The new thread inherits the restrictive signal mask set here,
511      * and enables signals again when it is set up properly. */
512     pthread_attr_t attr;
513     sigset_t newset,oldset;
514     boolean r=1;
515     int retcode, initcode, sizecode, addrcode;
516
517     FSHOW_SIGNAL((stderr,"/create_os_thread: creating new thread\n"));
518
519 #ifdef LOCK_CREATE_THREAD
520     retcode = pthread_mutex_lock(&create_thread_lock);
521     gc_assert(retcode == 0);
522     FSHOW_SIGNAL((stderr,"/create_os_thread: got lock\n"));
523 #endif
524     sigemptyset(&newset);
525     /* Blocking deferrable signals is enough, no need to block
526      * SIG_STOP_FOR_GC because the child process is not linked onto
527      * all_threads until it's ready. */
528     sigaddset_deferrable(&newset);
529     thread_sigmask(SIG_BLOCK, &newset, &oldset);
530
531 #if defined(LISP_FEATURE_DARWIN)
532 #define CONTROL_STACK_ADJUST 8192 /* darwin wants page-aligned stacks */
533 #else
534 #define CONTROL_STACK_ADJUST 16
535 #endif
536
537     if((initcode = pthread_attr_init(&attr)) ||
538        /* FIXME: why do we even have this in the first place? */
539        (pthread_attr_setstack(&attr,th->control_stack_start,
540                               THREAD_CONTROL_STACK_SIZE-CONTROL_STACK_ADJUST)) ||
541 #undef CONTROL_STACK_ADJUST
542        (retcode = pthread_create
543         (kid_tid,&attr,(void *(*)(void *))new_thread_trampoline,th))) {
544         FSHOW_SIGNAL((stderr, "init, size, addr = %d, %d, %d\n", initcode, sizecode, addrcode));
545         FSHOW_SIGNAL((stderr, printf("pthread_create returned %d, errno %d\n", retcode, errno)));
546         FSHOW_SIGNAL((stderr, "wanted stack size %d, min stack size %d\n",
547                       THREAD_CONTROL_STACK_SIZE-16, PTHREAD_STACK_MIN));
548         if(retcode < 0) {
549             perror("create_os_thread");
550         }
551         r=0;
552     }
553
554 #ifdef QUEUE_FREEABLE_THREAD_STACKS
555     free_freeable_stacks();
556 #endif
557     thread_sigmask(SIG_SETMASK,&oldset,0);
558 #ifdef LOCK_CREATE_THREAD
559     retcode = pthread_mutex_unlock(&create_thread_lock);
560     gc_assert(retcode == 0);
561     FSHOW_SIGNAL((stderr,"/create_os_thread: released lock\n"));
562 #endif
563     return r;
564 }
565
566 os_thread_t create_thread(lispobj initial_function) {
567     struct thread *th;
568     os_thread_t kid_tid;
569
570     /* Assuming that a fresh thread struct has no lisp objects in it,
571      * linking it to all_threads can be left to the thread itself
572      * without fear of gc lossage. initial_function violates this
573      * assumption and must stay pinned until the child starts up. */
574     th = create_thread_struct(initial_function);
575     if(th==0) return 0;
576
577     if (create_os_thread(th,&kid_tid)) {
578         return kid_tid;
579     } else {
580         free_thread_struct(th);
581         return 0;
582     }
583 }
584
585 /* Send the signo to os_thread, retry if the rt signal queue is
586  * full. */
587 int
588 kill_thread_safely(os_thread_t os_thread, int signo)
589 {
590     int r;
591     /* The man page does not mention EAGAIN as a valid return value
592      * for either pthread_kill or kill. But that's theory, this is
593      * practice. By waiting here we assume that the delivery of this
594      * signal is not necessary for the delivery of the signals in the
595      * queue. In other words, we _assume_ there are no deadlocks. */
596     while ((r=pthread_kill(os_thread,signo))==EAGAIN) {
597         /* wait a bit then try again in the hope of the rt signal
598          * queue not being full */
599         FSHOW_SIGNAL((stderr,"/rt signal queue full\n"));
600         /* FIXME: some kind of backoff (random, exponential) would be
601          * nice. */
602         sleep(1);
603     }
604     return r;
605 }
606
607 int signal_interrupt_thread(os_thread_t os_thread)
608 {
609     int status = kill_thread_safely(os_thread, SIG_INTERRUPT_THREAD);
610     if (status == 0) {
611         return 0;
612     } else if (status == ESRCH) {
613         return -1;
614     } else {
615         lose("cannot send SIG_INTERRUPT_THREAD to thread=%lu: %d, %s\n",
616              os_thread, status, strerror(status));
617     }
618 }
619
620 /* stopping the world is a two-stage process.  From this thread we signal
621  * all the others with SIG_STOP_FOR_GC.  The handler for this signal does
622  * the usual pseudo-atomic checks (we don't want to stop a thread while
623  * it's in the middle of allocation) then waits for another SIG_STOP_FOR_GC.
624  */
625
626 /* To avoid deadlocks when gc stops the world all clients of each
627  * mutex must enable or disable SIG_STOP_FOR_GC for the duration of
628  * holding the lock, but they must agree on which. */
629 void gc_stop_the_world()
630 {
631     struct thread *p,*th=arch_os_get_current_thread();
632     int status, lock_ret;
633 #ifdef LOCK_CREATE_THREAD
634     /* KLUDGE: Stopping the thread during pthread_create() causes deadlock
635      * on FreeBSD. */
636     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:waiting on create_thread_lock, thread=%lu\n",
637                   th->os_thread));
638     lock_ret = pthread_mutex_lock(&create_thread_lock);
639     gc_assert(lock_ret == 0);
640     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:got create_thread_lock, thread=%lu\n",
641                   th->os_thread));
642 #endif
643     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:waiting on lock, thread=%lu\n",
644                   th->os_thread));
645     /* keep threads from starting while the world is stopped. */
646     lock_ret = pthread_mutex_lock(&all_threads_lock);      \
647     gc_assert(lock_ret == 0);
648
649     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:got lock, thread=%lu\n",
650                   th->os_thread));
651     /* stop all other threads by sending them SIG_STOP_FOR_GC */
652     for(p=all_threads; p; p=p->next) {
653         gc_assert(p->os_thread != 0);
654         FSHOW_SIGNAL((stderr,"/gc_stop_the_world: p->state: %x\n", p->state));
655         if((p!=th) && ((p->state==STATE_RUNNING))) {
656             FSHOW_SIGNAL((stderr,"/gc_stop_the_world: suspending %x, os_thread %x\n",
657                           p, p->os_thread));
658             status=kill_thread_safely(p->os_thread,SIG_STOP_FOR_GC);
659             if (status==ESRCH) {
660                 /* This thread has exited. */
661                 gc_assert(p->state==STATE_DEAD);
662             } else if (status) {
663                 lose("cannot send suspend thread=%lu: %d, %s\n",
664                      p->os_thread,status,strerror(status));
665             }
666         }
667     }
668     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:signals sent\n"));
669     /* wait for the running threads to stop or finish */
670     for(p=all_threads;p;) {
671         FSHOW_SIGNAL((stderr,"/gc_stop_the_world: th: %p, p: %p\n", th, p));
672         if((p!=th) && (p->state==STATE_RUNNING)) {
673             sched_yield();
674         } else {
675             p=p->next;
676         }
677     }
678     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:end\n"));
679 }
680
681 void gc_start_the_world()
682 {
683     struct thread *p,*th=arch_os_get_current_thread();
684     int status, lock_ret;
685     /* if a resumed thread creates a new thread before we're done with
686      * this loop, the new thread will get consed on the front of
687      * all_threads, but it won't have been stopped so won't need
688      * restarting */
689     FSHOW_SIGNAL((stderr,"/gc_start_the_world:begin\n"));
690     for(p=all_threads;p;p=p->next) {
691         gc_assert(p->os_thread!=0);
692         if((p!=th) && (p->state!=STATE_DEAD)) {
693             if(p->state!=STATE_SUSPENDED) {
694                 lose("gc_start_the_world: wrong thread state is %d\n",
695                      fixnum_value(p->state));
696             }
697             FSHOW_SIGNAL((stderr, "/gc_start_the_world: resuming %lu\n",
698                           p->os_thread));
699             p->state=STATE_RUNNING;
700
701 #if defined(SIG_RESUME_FROM_GC)
702             status=kill_thread_safely(p->os_thread,SIG_RESUME_FROM_GC);
703 #else
704             status=kill_thread_safely(p->os_thread,SIG_STOP_FOR_GC);
705 #endif
706             if (status) {
707                 lose("cannot resume thread=%lu: %d, %s\n",
708                      p->os_thread,status,strerror(status));
709             }
710         }
711     }
712     /* If we waited here until all threads leave STATE_SUSPENDED, then
713      * SIG_STOP_FOR_GC wouldn't need to be a rt signal. That has some
714      * performance implications, but does away with the 'rt signal
715      * queue full' problem. */
716
717     lock_ret = pthread_mutex_unlock(&all_threads_lock);
718     gc_assert(lock_ret == 0);
719 #ifdef LOCK_CREATE_THREAD
720     lock_ret = pthread_mutex_unlock(&create_thread_lock);
721     gc_assert(lock_ret == 0);
722 #endif
723
724     FSHOW_SIGNAL((stderr,"/gc_start_the_world:end\n"));
725 }
726 #endif