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 "runtime.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 BINDING_STACK_SIZE etc */
  36 #include "thread.h"
  37 #include "arch.h"
  38 #include "target-arch-os.h"
  39 #include "os.h"
  40 #include "globals.h"
  41 #include "dynbind.h"
  42 #include "genesis/cons.h"
  43 #include "genesis/fdefn.h"
  44 #include "interr.h"             /* for lose() */
  45 #include "alloc.h"
  46 #include "gc-internal.h"
  47 #include "cpputil.h"
  48 #include "pseudo-atomic.h"
  49 #include "interrupt.h"
  50 #include "lispregs.h"
  51
  52 #ifdef LISP_FEATURE_SB_THREAD
  53
  54 #ifdef LISP_FEATURE_OPENBSD
  55 #include <pthread_np.h>
  56 #endif
  57
  58 #ifdef LISP_FEATURE_SUNOS
  59 #include <thread.h>
  60 #endif
  61
  62 #ifdef LISP_FEATURE_WIN32
  63 # define IMMEDIATE_POST_MORTEM
  64 #endif
  65
  66 #ifdef LISP_FEATURE_DARWIN
  67 #define DELAY_THREAD_POST_MORTEM 5
  68 #define LOCK_CREATE_THREAD
  69 #endif
  70
  71 #endif
  72
  73 #if defined(LISP_FEATURE_FREEBSD) || defined(LISP_FEATURE_DRAGONFLY)
  74 #define LOCK_CREATE_THREAD
  75 #endif
  76
  77 #ifdef LISP_FEATURE_SB_THREAD
  78 struct thread_post_mortem {
  79 #ifdef DELAY_THREAD_POST_MORTEM
  80     struct thread_post_mortem *next;
  81 #endif
  82     os_thread_t os_thread;
  83     pthread_attr_t *os_attr;
  84     os_vm_address_t os_address;
  85 };
  86
  87 #ifdef DELAY_THREAD_POST_MORTEM
  88 static int pending_thread_post_mortem_count = 0;
  89 pthread_mutex_t thread_post_mortem_lock = PTHREAD_MUTEX_INITIALIZER;
  90 #endif
  91 static struct thread_post_mortem * volatile pending_thread_post_mortem = 0;
  92 #endif
  93
  94 int dynamic_values_bytes=TLS_SIZE*sizeof(lispobj);  /* same for all threads */
  95 struct thread *all_threads;
  96 extern struct interrupt_data * global_interrupt_data;
  97
  98 #ifdef LISP_FEATURE_SB_THREAD
  99 pthread_mutex_t all_threads_lock = PTHREAD_MUTEX_INITIALIZER;
 100 #ifdef LOCK_CREATE_THREAD
 101 static pthread_mutex_t create_thread_lock = PTHREAD_MUTEX_INITIALIZER;
 102 #endif
 103 #ifdef LISP_FEATURE_GCC_TLS
 104 __thread struct thread *current_thread;
 105 #endif
 106 pthread_key_t lisp_thread = 0;
 107 #endif
 108
 109 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 110 extern lispobj call_into_lisp_first_time(lispobj fun, lispobj *args, int nargs)
 111 # ifdef LISP_FEATURE_X86_64
 112     __attribute__((sysv_abi))
 113 # endif
 114     ;
 115 #endif
 116
 117 static void
 118 link_thread(struct thread *th)
 119 {
 120     if (all_threads) all_threads->prev=th;
 121     th->next=all_threads;
 122     th->prev=0;
 123     all_threads=th;
 124 }
 125
 126 #ifdef LISP_FEATURE_SB_THREAD
 127 static void
 128 unlink_thread(struct thread *th)
 129 {
 130     if (th->prev)
 131         th->prev->next = th->next;
 132     else
 133         all_threads = th->next;
 134     if (th->next)
 135         th->next->prev = th->prev;
 136 }
 137
 138 #ifndef LISP_FEATURE_SB_SAFEPOINT
 139 /* Only access thread state with blockables blocked. */
 140 lispobj
 141 thread_state(struct thread *thread)
 142 {
 143     lispobj state;
 144     sigset_t old;
 145     block_blockable_signals(NULL, &old);
 146     os_sem_wait(thread->state_sem, "thread_state");
 147     state = thread->state;
 148     os_sem_post(thread->state_sem, "thread_state");
 149     thread_sigmask(SIG_SETMASK, &old, NULL);
 150     return state;
 151 }
 152
 153 void
 154 set_thread_state(struct thread *thread, lispobj state)
 155 {
 156     int i, waitcount = 0;
 157     sigset_t old;
 158     block_blockable_signals(NULL, &old);
 159     os_sem_wait(thread->state_sem, "set_thread_state");
 160     if (thread->state != state) {
 161         if ((STATE_STOPPED==state) ||
 162             (STATE_DEAD==state)) {
 163             waitcount = thread->state_not_running_waitcount;
 164             thread->state_not_running_waitcount = 0;
 165             for (i=0; i<waitcount; i++)
 166                 os_sem_post(thread->state_not_running_sem, "set_thread_state (not running)");
 167         }
 168         if ((STATE_RUNNING==state) ||
 169             (STATE_DEAD==state)) {
 170             waitcount = thread->state_not_stopped_waitcount;
 171             thread->state_not_stopped_waitcount = 0;
 172             for (i=0; i<waitcount; i++)
 173                 os_sem_post(thread->state_not_stopped_sem, "set_thread_state (not stopped)");
 174         }
 175         thread->state = state;
 176     }
 177     os_sem_post(thread->state_sem, "set_thread_state");
 178     thread_sigmask(SIG_SETMASK, &old, NULL);
 179 }
 180
 181 void
 182 wait_for_thread_state_change(struct thread *thread, lispobj state)
 183 {
 184     sigset_t old;
 185     os_sem_t *wait_sem;
 186     block_blockable_signals(NULL, &old);
 187   start:
 188     os_sem_wait(thread->state_sem, "wait_for_thread_state_change");
 189     if (thread->state == state) {
 190         switch (state) {
 191         case STATE_RUNNING:
 192             wait_sem = thread->state_not_running_sem;
 193             thread->state_not_running_waitcount++;
 194             break;
 195         case STATE_STOPPED:
 196             wait_sem = thread->state_not_stopped_sem;
 197             thread->state_not_stopped_waitcount++;
 198             break;
 199         default:
 200             lose("Invalid state in wait_for_thread_state_change: "OBJ_FMTX"\n", state);
 201         }
 202     } else {
 203         wait_sem = NULL;
 204     }
 205     os_sem_post(thread->state_sem, "wait_for_thread_state_change");
 206     if (wait_sem) {
 207         os_sem_wait(wait_sem, "wait_for_thread_state_change");
 208         goto start;
 209     }
 210     thread_sigmask(SIG_SETMASK, &old, NULL);
 211 }
 212 #endif /* sb-safepoint */
 213 #endif /* sb-thread */
 214
 215 static int
 216 initial_thread_trampoline(struct thread *th)
 217 {
 218     lispobj function;
 219 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 220     lispobj *args = NULL;
 221 #endif
 222 #ifdef LISP_FEATURE_SB_THREAD
 223     pthread_setspecific(lisp_thread, (void *)1);
 224 #endif
 225 #if defined(THREADS_USING_GCSIGNAL) && defined(LISP_FEATURE_PPC)
 226     /* SIG_STOP_FOR_GC defaults to blocked on PPC? */
 227     unblock_gc_signals(0,0);
 228 #endif
 229     function = th->no_tls_value_marker;
 230     th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
 231     if(arch_os_thread_init(th)==0) return 1;
 232     link_thread(th);
 233     th->os_thread=thread_self();
 234 #ifndef LISP_FEATURE_WIN32
 235     protect_control_stack_hard_guard_page(1, NULL);
 236 #endif
 237     protect_binding_stack_hard_guard_page(1, NULL);
 238     protect_alien_stack_hard_guard_page(1, NULL);
 239 #ifndef LISP_FEATURE_WIN32
 240     protect_control_stack_guard_page(1, NULL);
 241 #endif
 242     protect_binding_stack_guard_page(1, NULL);
 243     protect_alien_stack_guard_page(1, NULL);
 244
 245 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 246     return call_into_lisp_first_time(function,args,0);
 247 #else
 248     return funcall0(function);
 249 #endif
 250 }
 251
 252 #ifdef LISP_FEATURE_SB_THREAD
 253
 254 # if defined(IMMEDIATE_POST_MORTEM)
 255
 256 /*
 257  * If this feature is set, we are running on a stack managed by the OS,
 258  * and no fancy delays are required for anything.  Just do it.
 259  */
 260 static void
 261 schedule_thread_post_mortem(struct thread *corpse)
 262 {
 263     pthread_detach(pthread_self());
 264     gc_assert(!pthread_attr_destroy(corpse->os_attr));
 265     free(corpse->os_attr);
 266 #if defined(LISP_FEATURE_WIN32)
 267     os_invalidate_free(corpse->os_address, THREAD_STRUCT_SIZE);
 268 #else
 269     os_invalidate(corpse->os_address, THREAD_STRUCT_SIZE);
 270 #endif
 271 }
 272
 273 # else
 274
 275 /* THREAD POST MORTEM CLEANUP
 276  *
 277  * Memory allocated for the thread stacks cannot be reclaimed while
 278  * the thread is still alive, so we need a mechanism for post mortem
 279  * cleanups. FIXME: We actually have three, for historical reasons as
 280  * the saying goes. Do we really need three? Nikodemus guesses that
 281  * not anymore, now that we properly call pthread_attr_destroy before
 282  * freeing the stack. */
 283
 284 static struct thread_post_mortem *
 285 plan_thread_post_mortem(struct thread *corpse)
 286 {
 287     if (corpse) {
 288         struct thread_post_mortem *post_mortem = malloc(sizeof(struct thread_post_mortem));
 289         gc_assert(post_mortem);
 290         post_mortem->os_thread = corpse->os_thread;
 291         post_mortem->os_attr = corpse->os_attr;
 292         post_mortem->os_address = corpse->os_address;
 293 #ifdef DELAY_THREAD_POST_MORTEM
 294         post_mortem->next = NULL;
 295 #endif
 296         return post_mortem;
 297     } else {
 298         /* FIXME: When does this happen? */
 299         return NULL;
 300     }
 301 }
 302
 303 static void
 304 perform_thread_post_mortem(struct thread_post_mortem *post_mortem)
 305 {
 306 #ifdef CREATE_POST_MORTEM_THREAD
 307     pthread_detach(pthread_self());
 308 #endif
 309     if (post_mortem) {
 310         gc_assert(!pthread_join(post_mortem->os_thread, NULL));
 311         gc_assert(!pthread_attr_destroy(post_mortem->os_attr));
 312         free(post_mortem->os_attr);
 313         os_invalidate(post_mortem->os_address, THREAD_STRUCT_SIZE);
 314         free(post_mortem);
 315     }
 316 }
 317
 318 static void
 319 schedule_thread_post_mortem(struct thread *corpse)
 320 {
 321     struct thread_post_mortem *post_mortem = NULL;
 322     if (corpse) {
 323         post_mortem = plan_thread_post_mortem(corpse);
 324
 325 #ifdef DELAY_THREAD_POST_MORTEM
 326         pthread_mutex_lock(&thread_post_mortem_lock);
 327         /* First stick the new post mortem to the end of the queue. */
 328         if (pending_thread_post_mortem) {
 329             struct thread_post_mortem *next = pending_thread_post_mortem;
 330             while (next->next) {
 331                 next = next->next;
 332             }
 333             next->next = post_mortem;
 334         } else {
 335             pending_thread_post_mortem = post_mortem;
 336         }
 337         /* Then, if there are enough things in the queue, clean up one
 338          * from the head -- or increment the count, and null out the
 339          * post_mortem we have. */
 340         if (pending_thread_post_mortem_count > DELAY_THREAD_POST_MORTEM) {
 341             post_mortem = pending_thread_post_mortem;
 342             pending_thread_post_mortem = post_mortem->next;
 343         } else {
 344             pending_thread_post_mortem_count++;
 345             post_mortem = NULL;
 346         }
 347         pthread_mutex_unlock(&thread_post_mortem_lock);
 348         /* Finally run, the cleanup, if any. */
 349         perform_thread_post_mortem(post_mortem);
 350 #elif defined(CREATE_POST_MORTEM_THREAD)
 351         gc_assert(!pthread_create(&thread, NULL, perform_thread_post_mortem, post_mortem));
 352 #else
 353         post_mortem = (struct thread_post_mortem *)
 354             swap_lispobjs((lispobj *)(void *)&pending_thread_post_mortem,
 355                           (lispobj)post_mortem);
 356         perform_thread_post_mortem(post_mortem);
 357 #endif
 358     }
 359 }
 360
 361 # endif /* !IMMEDIATE_POST_MORTEM */
 362
 363 /* Note: scribble must be stack-allocated */
 364 static void
 365 init_new_thread(struct thread *th, init_thread_data *scribble, int guardp)
 366 {
 367     int lock_ret;
 368
 369     pthread_setspecific(lisp_thread, (void *)1);
 370     if(arch_os_thread_init(th)==0) {
 371         /* FIXME: handle error */
 372         lose("arch_os_thread_init failed\n");
 373     }
 374
 375     th->os_thread=thread_self();
 376     if (guardp)
 377         protect_control_stack_guard_page(1, NULL);
 378     protect_binding_stack_guard_page(1, NULL);
 379     protect_alien_stack_guard_page(1, NULL);
 380     /* Since GC can only know about this thread from the all_threads
 381      * list and we're just adding this thread to it, there is no
 382      * danger of deadlocking even with SIG_STOP_FOR_GC blocked (which
 383      * it is not). */
 384 #ifdef LISP_FEATURE_SB_SAFEPOINT
 385     *th->csp_around_foreign_call = (lispobj)scribble;
 386 #endif
 387     lock_ret = pthread_mutex_lock(&all_threads_lock);
 388     gc_assert(lock_ret == 0);
 389     link_thread(th);
 390     lock_ret = pthread_mutex_unlock(&all_threads_lock);
 391     gc_assert(lock_ret == 0);
 392
 393     /* Kludge: Changed the order of some steps between the safepoint/
 394      * non-safepoint versions of this code.  Can we unify this more?
 395      */
 396 #ifdef LISP_FEATURE_SB_SAFEPOINT
 397     gc_state_lock();
 398     gc_state_wait(GC_NONE);
 399     gc_state_unlock();
 400     push_gcing_safety(&scribble->safety);
 401 #endif
 402 }
 403
 404 static void
 405 undo_init_new_thread(struct thread *th, init_thread_data *scribble)
 406 {
 407     int lock_ret;
 408
 409     /* Kludge: Changed the order of some steps between the safepoint/
 410      * non-safepoint versions of this code.  Can we unify this more?
 411      */
 412 #ifdef LISP_FEATURE_SB_SAFEPOINT
 413     block_blockable_signals(0, 0);
 414     gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region);
 415 #if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
 416     gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->sprof_alloc_region);
 417 #endif
 418     pop_gcing_safety(&scribble->safety);
 419     lock_ret = pthread_mutex_lock(&all_threads_lock);
 420     gc_assert(lock_ret == 0);
 421     unlink_thread(th);
 422     lock_ret = pthread_mutex_unlock(&all_threads_lock);
 423     gc_assert(lock_ret == 0);
 424 #else
 425     /* Block GC */
 426     block_blockable_signals(0, 0);
 427     set_thread_state(th, STATE_DEAD);
 428
 429     /* SIG_STOP_FOR_GC is blocked and GC might be waiting for this
 430      * thread, but since we are already dead it won't wait long. */
 431     lock_ret = pthread_mutex_lock(&all_threads_lock);
 432     gc_assert(lock_ret == 0);
 433
 434     gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region);
 435 #if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
 436     gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->sprof_alloc_region);
 437 #endif
 438     unlink_thread(th);
 439     pthread_mutex_unlock(&all_threads_lock);
 440     gc_assert(lock_ret == 0);
 441 #endif
 442
 443     if(th->tls_cookie>=0) arch_os_thread_cleanup(th);
 444 #ifndef LISP_FEATURE_SB_SAFEPOINT
 445     os_sem_destroy(th->state_sem);
 446     os_sem_destroy(th->state_not_running_sem);
 447     os_sem_destroy(th->state_not_stopped_sem);
 448 #endif
 449
 450 #if defined(LISP_FEATURE_WIN32)
 451     free((os_vm_address_t)th->interrupt_data);
 452 #else
 453     os_invalidate((os_vm_address_t)th->interrupt_data,
 454                   (sizeof (struct interrupt_data)));
 455 #endif
 456
 457 #ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
 458     mach_lisp_thread_destroy(th);
 459 #endif
 460
 461 #if defined(LISP_FEATURE_WIN32)
 462     int i;
 463     for (i = 0; i<
 464              (int) (sizeof(th->private_events.events)/
 465                     sizeof(th->private_events.events[0])); ++i) {
 466       CloseHandle(th->private_events.events[i]);
 467     }
 468     TlsSetValue(OUR_TLS_INDEX,NULL);
 469 #endif
 470
 471     /* Undo the association of the current pthread to its `struct thread',
 472      * such that we can call arch_os_get_current_thread() later in this
 473      * thread and cleanly get back NULL. */
 474 #ifdef LISP_FEATURE_GCC_TLS
 475     current_thread = NULL;
 476 #else
 477     pthread_setspecific(specials, NULL);
 478 #endif
 479
 480     schedule_thread_post_mortem(th);
 481 }
 482
 483 /* this is the first thing that runs in the child (which is why the
 484  * silly calling convention).  Basically it calls the user's requested
 485  * lisp function after doing arch_os_thread_init and whatever other
 486  * bookkeeping needs to be done
 487  */
 488 int
 489 new_thread_trampoline(struct thread *th)
 490 {
 491     int result;
 492     init_thread_data scribble;
 493
 494     FSHOW((stderr,"/creating thread %lu\n", thread_self()));
 495     check_deferrables_blocked_or_lose(0);
 496 #ifndef LISP_FEATURE_SB_SAFEPOINT
 497     check_gc_signals_unblocked_or_lose(0);
 498 #endif
 499
 500     lispobj function = th->no_tls_value_marker;
 501     th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
 502     init_new_thread(th, &scribble, 1);
 503     result = funcall0(function);
 504     undo_init_new_thread(th, &scribble);
 505
 506     FSHOW((stderr,"/exiting thread %lu\n", thread_self()));
 507     return result;
 508 }
 509
 510 static struct thread *create_thread_struct(lispobj);
 511
 512 void
 513 attach_os_thread(init_thread_data *scribble)
 514 {
 515     os_thread_t os = pthread_self();
 516     odxprint(misc, "attach_os_thread: attaching to %p", os);
 517
 518     struct thread *th = create_thread_struct(NIL);
 519     block_deferrable_signals(0, &scribble->oldset);
 520     th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
 521     /* We don't actually want a pthread_attr here, but rather than add
 522      * `if's to the post-mostem, let's just keep that code happy by
 523      * keeping it initialized: */
 524     pthread_attr_init(th->os_attr);
 525
 526 #ifndef LISP_FEATURE_WIN32
 527     /* On windows, arch_os_thread_init will take care of finding the
 528      * stack. */
 529     void *stack_addr;
 530     size_t stack_size;
 531 #ifdef LISP_FEATURE_OPENBSD
 532     stack_t stack;
 533     pthread_stackseg_np(os, &stack);
 534     stack_size = stack.ss_size;
 535     stack_addr = (void*)((size_t)stack.ss_sp - stack_size);
 536 #elif defined LISP_FEATURE_SUNOS
 537   stack_t stack;
 538   thr_stksegment(&stack);
 539   stack_size = stack.ss_size;
 540   stack_addr = (void*)((size_t)stack.ss_sp - stack_size);
 541 #elif defined(LISP_FEATURE_DARWIN)
 542     stack_addr = pthread_get_stackaddr_np(os);
 543     stack_size = pthread_get_stacksize_np(os);
 544 #else
 545     pthread_attr_t attr;
 546 #ifdef LISP_FEATURE_FREEBSD
 547     pthread_attr_get_np(os, &attr);
 548 #else
 549     int pthread_getattr_np(pthread_t, pthread_attr_t *);
 550     pthread_getattr_np(os, &attr);
 551 #endif
 552     pthread_attr_getstack(&attr, &stack_addr, &stack_size);
 553 #endif
 554
 555     th->control_stack_start = stack_addr;
 556     th->control_stack_end = (void *) (((uintptr_t) stack_addr) + stack_size);
 557 #endif
 558
 559     init_new_thread(th, scribble, 0);
 560
 561     /* We will be calling into Lisp soon, and the functions being called
 562      * recklessly ignore the comment in target-thread which says that we
 563      * must be careful to not cause GC while initializing a new thread.
 564      * Since we first need to create a fresh thread object, it's really
 565      * tempting to just perform such unsafe allocation though.  So let's
 566      * at least try to suppress GC before consing, and hope that it
 567      * works: */
 568     bind_variable(GC_INHIBIT, T, th);
 569
 570     uword_t stacksize
 571         = (uword_t) th->control_stack_end - (uword_t) th->control_stack_start;
 572     odxprint(misc, "attach_os_thread: attached %p as %p (0x%lx bytes stack)",
 573              os, th, (long) stacksize);
 574 }
 575
 576 void
 577 detach_os_thread(init_thread_data *scribble)
 578 {
 579     struct thread *th = arch_os_get_current_thread();
 580     odxprint(misc, "detach_os_thread: detaching");
 581
 582     undo_init_new_thread(th, scribble);
 583
 584     odxprint(misc, "deattach_os_thread: detached");
 585     pthread_setspecific(lisp_thread, (void *)0);
 586     thread_sigmask(SIG_SETMASK, &scribble->oldset, 0);
 587 }
 588
 589 void
 590 callback_wrapper_trampoline(
 591 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
 592     /* On the x86oid backends, the assembly wrapper happens to not pass
 593      * in ENTER_ALIEN_CALLBACK explicitly for safepoints.  However, the
 594      * platforms with precise GC are tricky enough already, and I want
 595      * to minimize the read-time conditionals.  For those platforms, I'm
 596      * only replacing funcall3 with callback_wrapper_trampoline while
 597      * keeping the arguments unchanged. --DFL */
 598     lispobj __attribute__((__unused__)) fun,
 599 #endif
 600     lispobj arg0, lispobj arg1, lispobj arg2)
 601 {
 602 #if defined(LISP_FEATURE_WIN32)
 603     pthread_np_notice_thread();
 604 #endif
 605     struct thread* th = arch_os_get_current_thread();
 606     if (!th) {                  /* callback invoked in non-lisp thread */
 607         init_thread_data scribble;
 608         attach_os_thread(&scribble);
 609         funcall3(StaticSymbolFunction(ENTER_FOREIGN_CALLBACK), arg0,arg1,arg2);
 610         detach_os_thread(&scribble);
 611         return;
 612     }
 613
 614 #ifdef LISP_FEATURE_WIN32
 615     /* arg2 is the pointer to a return value, which sits on the stack */
 616     th->carried_base_pointer = (os_context_register_t) *(((void**)arg2)-1);
 617 #endif
 618
 619 #ifdef LISP_FEATURE_SB_SAFEPOINT
 620     WITH_GC_AT_SAFEPOINTS_ONLY()
 621 #endif
 622     {
 623        funcall3(SymbolValue(ENTER_ALIEN_CALLBACK, 0), arg0, arg1, arg2);
 624
 625     }
 626 }
 627 #endif /* LISP_FEATURE_SB_THREAD */
 628
 629 static void
 630 free_thread_struct(struct thread *th)
 631 {
 632 #if defined(LISP_FEATURE_WIN32)
 633     if (th->interrupt_data) {
 634         os_invalidate_free((os_vm_address_t) th->interrupt_data,
 635                       (sizeof (struct interrupt_data)));
 636     }
 637     os_invalidate_free((os_vm_address_t) th->os_address,
 638                   THREAD_STRUCT_SIZE);
 639 #else
 640     if (th->interrupt_data)
 641         os_invalidate((os_vm_address_t) th->interrupt_data,
 642                       (sizeof (struct interrupt_data)));
 643     os_invalidate((os_vm_address_t) th->os_address,
 644                   THREAD_STRUCT_SIZE);
 645 #endif
 646 }
 647
 648 #ifdef LISP_FEATURE_SB_THREAD
 649 /* FIXME: should be MAX_INTERRUPTS -1 ? */
 650 const unsigned int tls_index_start =
 651   MAX_INTERRUPTS + sizeof(struct thread)/sizeof(lispobj);
 652 #endif
 653
 654 /* this is called from any other thread to create the new one, and
 655  * initialize all parts of it that can be initialized from another
 656  * thread
 657  */
 658
 659 static struct thread *
 660 create_thread_struct(lispobj initial_function) {
 661     union per_thread_data *per_thread;
 662     struct thread *th=0;        /*  subdue gcc */
 663     void *spaces=0;
 664     void *aligned_spaces=0;
 665 #if defined(LISP_FEATURE_SB_THREAD) || defined(LISP_FEATURE_WIN32)
 666     unsigned int i;
 667 #endif
 668
 669     /* May as well allocate all the spaces at once: it saves us from
 670      * having to decide what to do if only some of the allocations
 671      * succeed. SPACES must be appropriately aligned, since the GC
 672      * expects the control stack to start at a page boundary -- and
 673      * the OS may have even more rigorous requirements. We can't rely
 674      * on the alignment passed from os_validate, since that might
 675      * assume the current (e.g. 4k) pagesize, while we calculate with
 676      * the biggest (e.g. 64k) pagesize allowed by the ABI. */
 677     spaces=os_validate(0, THREAD_STRUCT_SIZE);
 678     if(!spaces)
 679         return NULL;
 680     /* Aligning up is safe as THREAD_STRUCT_SIZE has
 681      * THREAD_ALIGNMENT_BYTES padding. */
 682     aligned_spaces = (void *)((((uword_t)(char *)spaces)
 683                                + THREAD_ALIGNMENT_BYTES-1)
 684                               &~(uword_t)(THREAD_ALIGNMENT_BYTES-1));
 685     void* csp_page=
 686         (aligned_spaces+
 687          thread_control_stack_size+
 688          BINDING_STACK_SIZE+
 689          ALIEN_STACK_SIZE);
 690     per_thread=(union per_thread_data *)
 691         (csp_page + THREAD_CSP_PAGE_SIZE);
 692     struct nonpointer_thread_data *nonpointer_data
 693         = (void *) &per_thread->dynamic_values[TLS_SIZE];
 694
 695 #ifdef LISP_FEATURE_SB_THREAD
 696     for(i = 0; i < (dynamic_values_bytes / sizeof(lispobj)); i++)
 697         per_thread->dynamic_values[i] = NO_TLS_VALUE_MARKER_WIDETAG;
 698 #endif
 699
 700     th=&per_thread->thread;
 701     th->os_address = spaces;
 702     th->control_stack_start = aligned_spaces;
 703     th->binding_stack_start=
 704         (lispobj*)((void*)th->control_stack_start+thread_control_stack_size);
 705     th->control_stack_end = th->binding_stack_start;
 706     th->control_stack_guard_page_protected = T;
 707     th->alien_stack_start=
 708         (lispobj*)((void*)th->binding_stack_start+BINDING_STACK_SIZE);
 709     set_binding_stack_pointer(th,th->binding_stack_start);
 710     th->this=th;
 711     th->os_thread=0;
 712
 713 #ifdef LISP_FEATURE_SB_SAFEPOINT
 714 # ifdef LISP_FEATURE_WIN32
 715     th->carried_base_pointer = 0;
 716 # endif
 717 # ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
 718     th->pc_around_foreign_call = 0;
 719 # endif
 720     th->csp_around_foreign_call = csp_page;
 721 #endif
 722
 723 #ifdef LISP_FEATURE_SB_THREAD
 724     /* Contrary to the "allocate all the spaces at once" comment above,
 725      * the os_attr is allocated separately.  We cannot put it into the
 726      * nonpointer data, because it's used for post_mortem and freed
 727      * separately */
 728     th->os_attr=malloc(sizeof(pthread_attr_t));
 729     th->nonpointer_data = nonpointer_data;
 730 # ifndef LISP_FEATURE_SB_SAFEPOINT
 731     th->state_sem=&nonpointer_data->state_sem;
 732     th->state_not_running_sem=&nonpointer_data->state_not_running_sem;
 733     th->state_not_stopped_sem=&nonpointer_data->state_not_stopped_sem;
 734     os_sem_init(th->state_sem, 1);
 735     os_sem_init(th->state_not_running_sem, 0);
 736     os_sem_init(th->state_not_stopped_sem, 0);
 737 # endif
 738     th->state_not_running_waitcount = 0;
 739     th->state_not_stopped_waitcount = 0;
 740 #endif
 741     th->state=STATE_RUNNING;
 742 #ifdef ALIEN_STACK_GROWS_DOWNWARD
 743     th->alien_stack_pointer=((void *)th->alien_stack_start
 744                              + ALIEN_STACK_SIZE-N_WORD_BYTES);
 745 #else
 746     th->alien_stack_pointer=((void *)th->alien_stack_start);
 747 #endif
 748 #if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64) || defined(LISP_FEATURE_SB_THREAD)
 749     th->pseudo_atomic_bits=0;
 750 #endif
 751 #ifdef LISP_FEATURE_GENCGC
 752     gc_set_region_empty(&th->alloc_region);
 753 # if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
 754     gc_set_region_empty(&th->sprof_alloc_region);
 755 # endif
 756 #endif
 757 #ifdef LISP_FEATURE_SB_THREAD
 758     /* This parallels the same logic in globals.c for the
 759      * single-threaded foreign_function_call_active, KLUDGE and
 760      * all. */
 761 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 762     th->foreign_function_call_active = 0;
 763 #else
 764     th->foreign_function_call_active = 1;
 765 #endif
 766 #endif
 767
 768 #ifndef LISP_FEATURE_SB_THREAD
 769     /* the tls-points-into-struct-thread trick is only good for threaded
 770      * sbcl, because unithread sbcl doesn't have tls.  So, we copy the
 771      * appropriate values from struct thread here, and make sure that
 772      * we use the appropriate SymbolValue macros to access any of the
 773      * variable quantities from the C runtime.  It's not quite OAOOM,
 774      * it just feels like it */
 775     SetSymbolValue(BINDING_STACK_START,(lispobj)th->binding_stack_start,th);
 776     SetSymbolValue(CONTROL_STACK_START,(lispobj)th->control_stack_start,th);
 777     SetSymbolValue(CONTROL_STACK_END,(lispobj)th->control_stack_end,th);
 778 #if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64)
 779     SetSymbolValue(ALIEN_STACK_POINTER,(lispobj)th->alien_stack_pointer,th);
 780     SetSymbolValue(PSEUDO_ATOMIC_BITS,(lispobj)th->pseudo_atomic_bits,th);
 781 #endif
 782 #ifdef PSEUDO_ATOMIC_INTERRUPTED
 783     SetSymbolValue(PSEUDO_ATOMIC_ATOMIC,NIL,th);
 784     SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED,NIL,th);
 785 #endif
 786 #endif
 787     bind_variable(CURRENT_CATCH_BLOCK,make_fixnum(0),th);
 788     bind_variable(CURRENT_UNWIND_PROTECT_BLOCK,make_fixnum(0),th);
 789     bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,make_fixnum(0),th);
 790     bind_variable(INTERRUPT_PENDING, NIL,th);
 791     bind_variable(INTERRUPTS_ENABLED,T,th);
 792     bind_variable(ALLOW_WITH_INTERRUPTS,T,th);
 793     bind_variable(GC_PENDING,NIL,th);
 794     bind_variable(ALLOC_SIGNAL,NIL,th);
 795 #ifdef PINNED_OBJECTS
 796     bind_variable(PINNED_OBJECTS,NIL,th);
 797 #endif
 798 #ifdef LISP_FEATURE_SB_THREAD
 799     bind_variable(STOP_FOR_GC_PENDING,NIL,th);
 800 #endif
 801 #if defined(LISP_FEATURE_SB_SAFEPOINT)
 802     bind_variable(GC_SAFE,NIL,th);
 803     bind_variable(IN_SAFEPOINT,NIL,th);
 804 #endif
 805 #ifdef LISP_FEATURE_SB_THRUPTION
 806     bind_variable(THRUPTION_PENDING,NIL,th);
 807     bind_variable(RESTART_CLUSTERS,NIL,th);
 808 #endif
 809 #ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
 810     access_control_stack_pointer(th)=th->control_stack_start;
 811 #endif
 812
 813 #if defined(LISP_FEATURE_WIN32)
 814     th->interrupt_data = (struct interrupt_data *)
 815         calloc((sizeof (struct interrupt_data)),1);
 816 #else
 817     th->interrupt_data = (struct interrupt_data *)
 818         os_validate(0,(sizeof (struct interrupt_data)));
 819 #endif
 820     if (!th->interrupt_data) {
 821         free_thread_struct(th);
 822         return 0;
 823     }
 824     th->interrupt_data->pending_handler = 0;
 825     th->interrupt_data->gc_blocked_deferrables = 0;
 826 #ifdef GENCGC_IS_PRECISE
 827     th->interrupt_data->allocation_trap_context = 0;
 828 #endif
 829     th->no_tls_value_marker=initial_function;
 830
 831 #if defined(LISP_FEATURE_WIN32)
 832     for (i = 0; i<sizeof(th->private_events.events)/
 833            sizeof(th->private_events.events[0]); ++i) {
 834       th->private_events.events[i] = CreateEvent(NULL,FALSE,FALSE,NULL);
 835     }
 836     th->synchronous_io_handle_and_flag = 0;
 837 #endif
 838     th->stepping = NIL;
 839     return th;
 840 }
 841
 842 void create_initial_thread(lispobj initial_function) {
 843     struct thread *th=create_thread_struct(initial_function);
 844 #ifdef LISP_FEATURE_SB_THREAD
 845     pthread_key_create(&lisp_thread, 0);
 846 #endif
 847     if(th) {
 848         initial_thread_trampoline(th); /* no return */
 849     } else lose("can't create initial thread\n");
 850 }
 851
 852 #ifdef LISP_FEATURE_SB_THREAD
 853
 854 #ifndef __USE_XOPEN2K
 855 extern int pthread_attr_setstack (pthread_attr_t *__attr, void *__stackaddr,
 856                                   size_t __stacksize);
 857 #endif
 858
 859 boolean create_os_thread(struct thread *th,os_thread_t *kid_tid)
 860 {
 861     /* The new thread inherits the restrictive signal mask set here,
 862      * and enables signals again when it is set up properly. */
 863     sigset_t oldset;
 864     boolean r=1;
 865     int retcode = 0, initcode;
 866
 867     FSHOW_SIGNAL((stderr,"/create_os_thread: creating new thread\n"));
 868
 869     /* Blocking deferrable signals is enough, no need to block
 870      * SIG_STOP_FOR_GC because the child process is not linked onto
 871      * all_threads until it's ready. */
 872     block_deferrable_signals(0, &oldset);
 873
 874 #ifdef LOCK_CREATE_THREAD
 875     retcode = pthread_mutex_lock(&create_thread_lock);
 876     gc_assert(retcode == 0);
 877     FSHOW_SIGNAL((stderr,"/create_os_thread: got lock\n"));
 878 #endif
 879
 880     if((initcode = pthread_attr_init(th->os_attr)) ||
 881        /* call_into_lisp_first_time switches the stack for the initial
 882         * thread. For the others, we use this. */
 883 #if defined(LISP_FEATURE_WIN32)
 884        (pthread_attr_setstacksize(th->os_attr, thread_control_stack_size)) ||
 885 #else
 886 # if defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK)
 887        (pthread_attr_setstack(th->os_attr,th->control_stack_start,
 888                               thread_control_stack_size)) ||
 889 # else
 890        (pthread_attr_setstack(th->os_attr,th->alien_stack_start,
 891                               ALIEN_STACK_SIZE)) ||
 892 # endif
 893 #endif
 894        (retcode = pthread_create
 895         (kid_tid,th->os_attr,(void *(*)(void *))new_thread_trampoline,th))) {
 896         FSHOW_SIGNAL((stderr, "init = %d\n", initcode));
 897         FSHOW_SIGNAL((stderr, "pthread_create returned %d, errno %d\n",
 898                       retcode, errno));
 899         if(retcode < 0) {
 900             perror("create_os_thread");
 901         }
 902         r=0;
 903     }
 904
 905 #ifdef LOCK_CREATE_THREAD
 906     retcode = pthread_mutex_unlock(&create_thread_lock);
 907     gc_assert(retcode == 0);
 908     FSHOW_SIGNAL((stderr,"/create_os_thread: released lock\n"));
 909 #endif
 910     thread_sigmask(SIG_SETMASK,&oldset,0);
 911     return r;
 912 }
 913
 914 os_thread_t create_thread(lispobj initial_function) {
 915     struct thread *th, *thread = arch_os_get_current_thread();
 916     os_thread_t kid_tid = 0;
 917
 918     /* Must defend against async unwinds. */
 919     if (SymbolValue(INTERRUPTS_ENABLED, thread) != NIL)
 920         lose("create_thread is not safe when interrupts are enabled.\n");
 921
 922     /* Assuming that a fresh thread struct has no lisp objects in it,
 923      * linking it to all_threads can be left to the thread itself
 924      * without fear of gc lossage. initial_function violates this
 925      * assumption and must stay pinned until the child starts up. */
 926     th = create_thread_struct(initial_function);
 927     if (th && !create_os_thread(th,&kid_tid)) {
 928         free_thread_struct(th);
 929         kid_tid = 0;
 930     }
 931     return kid_tid;
 932 }
 933
 934 /* stopping the world is a two-stage process.  From this thread we signal
 935  * all the others with SIG_STOP_FOR_GC.  The handler for this signal does
 936  * the usual pseudo-atomic checks (we don't want to stop a thread while
 937  * it's in the middle of allocation) then waits for another SIG_STOP_FOR_GC.
 938  */
 939 /*
 940  * (With SB-SAFEPOINT, see the definitions in safepoint.c instead.)
 941  */
 942 #ifndef LISP_FEATURE_SB_SAFEPOINT
 943
 944 /* To avoid deadlocks when gc stops the world all clients of each
 945  * mutex must enable or disable SIG_STOP_FOR_GC for the duration of
 946  * holding the lock, but they must agree on which. */
 947 void gc_stop_the_world()
 948 {
 949     struct thread *p,*th=arch_os_get_current_thread();
 950     int status, lock_ret;
 951 #ifdef LOCK_CREATE_THREAD
 952     /* KLUDGE: Stopping the thread during pthread_create() causes deadlock
 953      * on FreeBSD. */
 954     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:waiting on create_thread_lock\n"));
 955     lock_ret = pthread_mutex_lock(&create_thread_lock);
 956     gc_assert(lock_ret == 0);
 957     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:got create_thread_lock\n"));
 958 #endif
 959     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:waiting on lock\n"));
 960     /* keep threads from starting while the world is stopped. */
 961     lock_ret = pthread_mutex_lock(&all_threads_lock);      \
 962     gc_assert(lock_ret == 0);
 963
 964     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:got lock\n"));
 965     /* stop all other threads by sending them SIG_STOP_FOR_GC */
 966     for(p=all_threads; p; p=p->next) {
 967         gc_assert(p->os_thread != 0);
 968         FSHOW_SIGNAL((stderr,"/gc_stop_the_world: thread=%lu, state=%x\n",
 969                       p->os_thread, thread_state(p)));
 970         if((p!=th) && ((thread_state(p)==STATE_RUNNING))) {
 971             FSHOW_SIGNAL((stderr,"/gc_stop_the_world: suspending thread %lu\n",
 972                           p->os_thread));
 973             /* We already hold all_thread_lock, P can become DEAD but
 974              * cannot exit, ergo it's safe to use pthread_kill. */
 975             status=pthread_kill(p->os_thread,SIG_STOP_FOR_GC);
 976             if (status==ESRCH) {
 977                 /* This thread has exited. */
 978                 gc_assert(thread_state(p)==STATE_DEAD);
 979             } else if (status) {
 980                 lose("cannot send suspend thread=%lu: %d, %s\n",
 981                      p->os_thread,status,strerror(status));
 982             }
 983         }
 984     }
 985     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:signals sent\n"));
 986     for(p=all_threads;p;p=p->next) {
 987         if (p!=th) {
 988             FSHOW_SIGNAL
 989                 ((stderr,
 990                   "/gc_stop_the_world: waiting for thread=%lu: state=%x\n",
 991                   p->os_thread, thread_state(p)));
 992             wait_for_thread_state_change(p, STATE_RUNNING);
 993             if (p->state == STATE_RUNNING)
 994                 lose("/gc_stop_the_world: unexpected state");
 995         }
 996     }
 997     FSHOW_SIGNAL((stderr,"/gc_stop_the_world:end\n"));
 998 }
 999
1000 void gc_start_the_world()
1001 {
1002     struct thread *p,*th=arch_os_get_current_thread();
1003     int lock_ret;
1004     /* if a resumed thread creates a new thread before we're done with
1005      * this loop, the new thread will get consed on the front of
1006      * all_threads, but it won't have been stopped so won't need
1007      * restarting */
1008     FSHOW_SIGNAL((stderr,"/gc_start_the_world:begin\n"));
1009     for(p=all_threads;p;p=p->next) {
1010         gc_assert(p->os_thread!=0);
1011         if (p!=th) {
1012             lispobj state = thread_state(p);
1013             if (state != STATE_DEAD) {
1014                 if(state != STATE_STOPPED) {
1015                     lose("gc_start_the_world: wrong thread state is %d\n",
1016                          fixnum_value(state));
1017                 }
1018                 FSHOW_SIGNAL((stderr, "/gc_start_the_world: resuming %lu\n",
1019                               p->os_thread));
1020                 set_thread_state(p, STATE_RUNNING);
1021             }
1022         }
1023     }
1024
1025     lock_ret = pthread_mutex_unlock(&all_threads_lock);
1026     gc_assert(lock_ret == 0);
1027 #ifdef LOCK_CREATE_THREAD
1028     lock_ret = pthread_mutex_unlock(&create_thread_lock);
1029     gc_assert(lock_ret == 0);
1030 #endif
1031
1032     FSHOW_SIGNAL((stderr,"/gc_start_the_world:end\n"));
1033 }
1034
1035 #endif /* !LISP_FEATURE_SB_SAFEPOINT */
1036 #endif /* !LISP_FEATURE_SB_THREAD */
1037
1038 int
1039 thread_yield()
1040 {
1041 #ifdef LISP_FEATURE_SB_THREAD
1042     return sched_yield();
1043 #else
1044     return 0;
1045 #endif
1046 }
1047
1048 int
1049 wake_thread(os_thread_t os_thread)
1050 {
1051 #if defined(LISP_FEATURE_WIN32)
1052     return kill_safely(os_thread, 1);
1053 #elif !defined(LISP_FEATURE_SB_THRUPTION)
1054     return kill_safely(os_thread, SIGPIPE);
1055 #else
1056     return wake_thread_posix(os_thread);
1057 #endif
1058 }
1059
1060 /* If the thread id given does not belong to a running thread (it has
1061  * exited or never even existed) pthread_kill _may_ fail with ESRCH,
1062  * but it is also allowed to just segfault, see
1063  * <http://udrepper.livejournal.com/16844.html>.
1064  *
1065  * Relying on thread ids can easily backfire since ids are recycled
1066  * (NPTL recycles them extremely fast) so a signal can be sent to
1067  * another process if the one it was sent to exited.
1068  *
1069  * For these reasons, we must make sure that the thread is still alive
1070  * when the pthread_kill is called and return if the thread is
1071  * exiting.
1072  *
1073  * Note (DFL, 2011-06-22): At the time of writing, this function is only
1074  * used for INTERRUPT-THREAD, hence the wake_thread special-case for
1075  * Windows is OK. */
1076 int
1077 kill_safely(os_thread_t os_thread, int signal)
1078 {
1079     FSHOW_SIGNAL((stderr,"/kill_safely: %lu, %d\n", os_thread, signal));
1080     {
1081 #ifdef LISP_FEATURE_SB_THREAD
1082         sigset_t oldset;
1083         struct thread *thread;
1084         /* Frequent special case: resignalling to self.  The idea is
1085          * that leave_region safepoint will acknowledge the signal, so
1086          * there is no need to take locks, roll thread to safepoint
1087          * etc. */
1088         /* Kludge (on safepoint builds): At the moment, this isn't just
1089          * an optimization; rather it masks the fact that
1090          * gc_stop_the_world() grabs the all_threads mutex without
1091          * releasing it, and since we're not using recursive pthread
1092          * mutexes, the pthread_mutex_lock() around the all_threads loop
1093          * would go wrong.  Why are we running interruptions while
1094          * stopping the world though?  Test case is (:ASYNC-UNWIND
1095          * :SPECIALS), especially with s/10/100/ in both loops. */
1096         if (os_thread == pthread_self()) {
1097             pthread_kill(os_thread, signal);
1098 #ifdef LISP_FEATURE_WIN32
1099             check_pending_thruptions(NULL);
1100 #endif
1101             return 0;
1102         }
1103
1104         /* pthread_kill is not async signal safe and we don't want to be
1105          * interrupted while holding the lock. */
1106         block_deferrable_signals(0, &oldset);
1107         pthread_mutex_lock(&all_threads_lock);
1108         for (thread = all_threads; thread; thread = thread->next) {
1109             if (thread->os_thread == os_thread) {
1110                 int status = pthread_kill(os_thread, signal);
1111                 if (status)
1112                     lose("kill_safely: pthread_kill failed with %d\n", status);
1113 #if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THRUPTION)
1114                 wake_thread_win32(thread);
1115 #endif
1116                 break;
1117             }
1118         }
1119         pthread_mutex_unlock(&all_threads_lock);
1120         thread_sigmask(SIG_SETMASK,&oldset,0);
1121         if (thread)
1122             return 0;
1123         else
1124             return -1;
1125 #elif defined(LISP_FEATURE_WIN32)
1126         return 0;
1127 #else
1128         int status;
1129         if (os_thread != 0)
1130             lose("kill_safely: who do you want to kill? %d?\n", os_thread);
1131         /* Dubious (as in don't know why it works) workaround for the
1132          * signal sometimes not being generated on darwin. */
1133 #ifdef LISP_FEATURE_DARWIN
1134         {
1135             sigset_t oldset;
1136             sigprocmask(SIG_BLOCK, &deferrable_sigset, &oldset);
1137             status = raise(signal);
1138             sigprocmask(SIG_SETMASK,&oldset,0);
1139         }
1140 #else
1141         status = raise(signal);
1142 #endif
1143         if (status == 0) {
1144             return 0;
1145         } else {
1146             lose("cannot raise signal %d, %d %s\n",
1147                  signal, status, strerror(errno));
1148         }
1149 #endif
1150     }
1151 }