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