src/thread.c

   1 /* Threading code.
   2 Copyright (C) 2012-2017 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software: you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation, either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
  18
  19
  20 #include <config.h>
  21 #include <setjmp.h>
  22 #include "lisp.h"
  23 #include "character.h"
  24 #include "buffer.h"
  25 #include "process.h"
  26 #include "coding.h"
  27 #include "syssignal.h"
  28
  29 static struct thread_state main_thread;
  30
  31 struct thread_state *current_thread = &main_thread;
  32
  33 static struct thread_state *all_threads = &main_thread;
  34
  35 static sys_mutex_t global_lock;
  36
  37 extern int poll_suppress_count;
  38 extern volatile int interrupt_input_blocked;
  39
  40 \f
  41
  42 /* m_specpdl is set when the thread is created and cleared when the
  43    thread dies.  */
  44 #define thread_alive_p(STATE) ((STATE)->m_specpdl != NULL)
  45
  46 \f
  47
  48 static void
  49 release_global_lock (void)
  50 {
  51   sys_mutex_unlock (&global_lock);
  52 }
  53
  54 /* You must call this after acquiring the global lock.
  55    acquire_global_lock does it for you.  */
  56 static void
  57 post_acquire_global_lock (struct thread_state *self)
  58 {
  59   struct thread_state *prev_thread = current_thread;
  60
  61   /* Do this early on, so that code below could signal errors (e.g.,
  62      unbind_for_thread_switch might) correctly, because we are already
  63      running in the context of the thread pointed by SELF.  */
  64   current_thread = self;
  65
  66   if (prev_thread != current_thread)
  67     {
  68       /* PREV_THREAD is NULL if the previously current thread
  69          exited.  In this case, there is no reason to unbind, and
  70          trying will crash.  */
  71       if (prev_thread != NULL)
  72         unbind_for_thread_switch (prev_thread);
  73       rebind_for_thread_switch ();
  74
  75        /* Set the new thread's current buffer.  This needs to be done
  76           even if it is the same buffer as that of the previous thread,
  77           because of thread-local bindings.  */
  78       set_buffer_internal_2 (current_buffer);
  79     }
  80
  81    /* We could have been signaled while waiting to grab the global lock
  82       for the first time since this thread was created, in which case
  83       we didn't yet have the opportunity to set up the handlers.  Delay
  84       raising the signal in that case (it will be actually raised when
  85       the thread comes here after acquiring the lock the next time).  */
  86   if (!NILP (current_thread->error_symbol) && handlerlist)
  87     {
  88       Lisp_Object sym = current_thread->error_symbol;
  89       Lisp_Object data = current_thread->error_data;
  90
  91       current_thread->error_symbol = Qnil;
  92       current_thread->error_data = Qnil;
  93       Fsignal (sym, data);
  94     }
  95 }
  96
  97 static void
  98 acquire_global_lock (struct thread_state *self)
  99 {
 100   sys_mutex_lock (&global_lock);
 101   post_acquire_global_lock (self);
 102 }
 103
 104 /* This is called from keyboard.c when it detects that SIGINT was
 105    delivered to the main thread and interrupted thread_select before
 106    the main thread could acquire the lock.  We must acquire the lock
 107    to prevent a thread from running without holding the global lock,
 108    and to avoid repeated calls to sys_mutex_unlock, which invokes
 109    undefined behavior.  */
 110 void
 111 maybe_reacquire_global_lock (void)
 112 {
 113   /* SIGINT handler is always run on the main thread, see
 114      deliver_process_signal, so reflect that in our thread-tracking
 115      variables.  */
 116   current_thread = &main_thread;
 117
 118   if (current_thread->not_holding_lock)
 119     {
 120       struct thread_state *self = current_thread;
 121
 122       acquire_global_lock (self);
 123       current_thread->not_holding_lock = 0;
 124     }
 125 }
 126
 127 \f
 128
 129 static void
 130 lisp_mutex_init (lisp_mutex_t *mutex)
 131 {
 132   mutex->owner = NULL;
 133   mutex->count = 0;
 134   sys_cond_init (&mutex->condition);
 135 }
 136
 137 /* Lock MUTEX for thread LOCKER, setting its lock count to COUNT, if
 138    non-zero, or to 1 otherwise.
 139
 140    If MUTEX is locked by LOCKER, COUNT must be zero, and the MUTEX's
 141    lock count will be incremented.
 142
 143    If MUTEX is locked by another thread, this function will release
 144    the global lock, giving other threads a chance to run, and will
 145    wait for the MUTEX to become unlocked; when MUTEX becomes unlocked,
 146    and will then re-acquire the global lock.
 147
 148    Return value is 1 if the function waited for the MUTEX to become
 149    unlocked (meaning other threads could have run during the wait),
 150    zero otherwise.  */
 151 static int
 152 lisp_mutex_lock_for_thread (lisp_mutex_t *mutex, struct thread_state *locker,
 153                             int new_count)
 154 {
 155   struct thread_state *self;
 156
 157   if (mutex->owner == NULL)
 158     {
 159       mutex->owner = locker;
 160       mutex->count = new_count == 0 ? 1 : new_count;
 161       return 0;
 162     }
 163   if (mutex->owner == locker)
 164     {
 165       eassert (new_count == 0);
 166       ++mutex->count;
 167       return 0;
 168     }
 169
 170   self = locker;
 171   self->wait_condvar = &mutex->condition;
 172   while (mutex->owner != NULL && (new_count != 0
 173                                   || NILP (self->error_symbol)))
 174     sys_cond_wait (&mutex->condition, &global_lock);
 175   self->wait_condvar = NULL;
 176
 177   if (new_count == 0 && !NILP (self->error_symbol))
 178     return 1;
 179
 180   mutex->owner = self;
 181   mutex->count = new_count == 0 ? 1 : new_count;
 182
 183   return 1;
 184 }
 185
 186 static int
 187 lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
 188 {
 189   return lisp_mutex_lock_for_thread (mutex, current_thread, new_count);
 190 }
 191
 192 /* Decrement MUTEX's lock count.  If the lock count becomes zero after
 193    decrementing it, meaning the mutex is now unlocked, broadcast that
 194    to all the threads that might be waiting to lock the mutex.  This
 195    function signals an error if MUTEX is locked by a thread other than
 196    the current one.  Return value is 1 if the mutex becomes unlocked,
 197    zero otherwise.  */
 198 static int
 199 lisp_mutex_unlock (lisp_mutex_t *mutex)
 200 {
 201   if (mutex->owner != current_thread)
 202     error ("Cannot unlock mutex owned by another thread");
 203
 204   if (--mutex->count > 0)
 205     return 0;
 206
 207   mutex->owner = NULL;
 208   sys_cond_broadcast (&mutex->condition);
 209
 210   return 1;
 211 }
 212
 213 /* Like lisp_mutex_unlock, but sets MUTEX's lock count to zero
 214    regardless of its value.  Return the previous lock count.  */
 215 static unsigned int
 216 lisp_mutex_unlock_for_wait (lisp_mutex_t *mutex)
 217 {
 218   unsigned int result = mutex->count;
 219
 220   /* Ensured by condvar code.  */
 221   eassert (mutex->owner == current_thread);
 222
 223   mutex->count = 0;
 224   mutex->owner = NULL;
 225   sys_cond_broadcast (&mutex->condition);
 226
 227   return result;
 228 }
 229
 230 static void
 231 lisp_mutex_destroy (lisp_mutex_t *mutex)
 232 {
 233   sys_cond_destroy (&mutex->condition);
 234 }
 235
 236 static int
 237 lisp_mutex_owned_p (lisp_mutex_t *mutex)
 238 {
 239   return mutex->owner == current_thread;
 240 }
 241
 242 \f
 243
 244 DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 1, 0,
 245        doc: /* Create a mutex.
 246 A mutex provides a synchronization point for threads.
 247 Only one thread at a time can hold a mutex.  Other threads attempting
 248 to acquire it will block until the mutex is available.
 249
 250 A thread can acquire a mutex any number of times.
 251
 252 NAME, if given, is used as the name of the mutex.  The name is
 253 informational only.  */)
 254   (Lisp_Object name)
 255 {
 256   struct Lisp_Mutex *mutex;
 257   Lisp_Object result;
 258
 259   if (!NILP (name))
 260     CHECK_STRING (name);
 261
 262   mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, mutex, PVEC_MUTEX);
 263   memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex),
 264           0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex,
 265                                                     mutex));
 266   mutex->name = name;
 267   lisp_mutex_init (&mutex->mutex);
 268
 269   XSETMUTEX (result, mutex);
 270   return result;
 271 }
 272
 273 static void
 274 mutex_lock_callback (void *arg)
 275 {
 276   struct Lisp_Mutex *mutex = arg;
 277   struct thread_state *self = current_thread;
 278
 279   /* Calling lisp_mutex_lock might yield to other threads while this
 280      one waits for the mutex to become unlocked, so we need to
 281      announce us as the current thread by calling
 282      post_acquire_global_lock.  */
 283   if (lisp_mutex_lock (&mutex->mutex, 0))
 284     post_acquire_global_lock (self);
 285 }
 286
 287 static void
 288 do_unwind_mutex_lock (void)
 289 {
 290   current_thread->event_object = Qnil;
 291 }
 292
 293 DEFUN ("mutex-lock", Fmutex_lock, Smutex_lock, 1, 1, 0,
 294        doc: /* Acquire a mutex.
 295 If the current thread already owns MUTEX, increment the count and
 296 return.
 297 Otherwise, if no thread owns MUTEX, make the current thread own it.
 298 Otherwise, block until MUTEX is available, or until the current thread
 299 is signaled using `thread-signal'.
 300 Note that calls to `mutex-lock' and `mutex-unlock' must be paired.  */)
 301   (Lisp_Object mutex)
 302 {
 303   struct Lisp_Mutex *lmutex;
 304   ptrdiff_t count = SPECPDL_INDEX ();
 305
 306   CHECK_MUTEX (mutex);
 307   lmutex = XMUTEX (mutex);
 308
 309   current_thread->event_object = mutex;
 310   record_unwind_protect_void (do_unwind_mutex_lock);
 311   flush_stack_call_func (mutex_lock_callback, lmutex);
 312   return unbind_to (count, Qnil);
 313 }
 314
 315 static void
 316 mutex_unlock_callback (void *arg)
 317 {
 318   struct Lisp_Mutex *mutex = arg;
 319   struct thread_state *self = current_thread;
 320
 321   if (lisp_mutex_unlock (&mutex->mutex))
 322     post_acquire_global_lock (self); /* FIXME: is this call needed? */
 323 }
 324
 325 DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0,
 326        doc: /* Release the mutex.
 327 If this thread does not own MUTEX, signal an error.
 328 Otherwise, decrement the mutex's count.  If the count is zero,
 329 release MUTEX.   */)
 330   (Lisp_Object mutex)
 331 {
 332   struct Lisp_Mutex *lmutex;
 333
 334   CHECK_MUTEX (mutex);
 335   lmutex = XMUTEX (mutex);
 336
 337   flush_stack_call_func (mutex_unlock_callback, lmutex);
 338   return Qnil;
 339 }
 340
 341 DEFUN ("mutex-name", Fmutex_name, Smutex_name, 1, 1, 0,
 342        doc: /* Return the name of MUTEX.
 343 If no name was given when MUTEX was created, return nil.  */)
 344   (Lisp_Object mutex)
 345 {
 346   struct Lisp_Mutex *lmutex;
 347
 348   CHECK_MUTEX (mutex);
 349   lmutex = XMUTEX (mutex);
 350
 351   return lmutex->name;
 352 }
 353
 354 void
 355 finalize_one_mutex (struct Lisp_Mutex *mutex)
 356 {
 357   lisp_mutex_destroy (&mutex->mutex);
 358 }
 359
 360 \f
 361
 362 DEFUN ("make-condition-variable",
 363        Fmake_condition_variable, Smake_condition_variable,
 364        1, 2, 0,
 365        doc: /* Make a condition variable associated with MUTEX.
 366 A condition variable provides a way for a thread to sleep while
 367 waiting for a state change.
 368
 369 MUTEX is the mutex associated with this condition variable.
 370 NAME, if given, is the name of this condition variable.  The name is
 371 informational only.  */)
 372   (Lisp_Object mutex, Lisp_Object name)
 373 {
 374   struct Lisp_CondVar *condvar;
 375   Lisp_Object result;
 376
 377   CHECK_MUTEX (mutex);
 378   if (!NILP (name))
 379     CHECK_STRING (name);
 380
 381   condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, cond, PVEC_CONDVAR);
 382   memset ((char *) condvar + offsetof (struct Lisp_CondVar, cond),
 383           0, sizeof (struct Lisp_CondVar) - offsetof (struct Lisp_CondVar,
 384                                                       cond));
 385   condvar->mutex = mutex;
 386   condvar->name = name;
 387   sys_cond_init (&condvar->cond);
 388
 389   XSETCONDVAR (result, condvar);
 390   return result;
 391 }
 392
 393 static void
 394 condition_wait_callback (void *arg)
 395 {
 396   struct Lisp_CondVar *cvar = arg;
 397   struct Lisp_Mutex *mutex = XMUTEX (cvar->mutex);
 398   struct thread_state *self = current_thread;
 399   unsigned int saved_count;
 400   Lisp_Object cond;
 401
 402   XSETCONDVAR (cond, cvar);
 403   self->event_object = cond;
 404   saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex);
 405   /* If signaled while unlocking, skip the wait but reacquire the lock.  */
 406   if (NILP (self->error_symbol))
 407     {
 408       self->wait_condvar = &cvar->cond;
 409       /* This call could switch to another thread.  */
 410       sys_cond_wait (&cvar->cond, &global_lock);
 411       self->wait_condvar = NULL;
 412     }
 413   self->event_object = Qnil;
 414   /* Since sys_cond_wait could switch threads, we need to lock the
 415      mutex for the thread which was the current when we were called,
 416      otherwise lisp_mutex_lock will record the wrong thread as the
 417      owner of the mutex lock.  */
 418   lisp_mutex_lock_for_thread (&mutex->mutex, self, saved_count);
 419   /* Calling lisp_mutex_lock_for_thread might yield to other threads
 420      while this one waits for the mutex to become unlocked, so we need
 421      to announce us as the current thread by calling
 422      post_acquire_global_lock.  */
 423   post_acquire_global_lock (self);
 424 }
 425
 426 DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0,
 427        doc: /* Wait for the condition variable COND to be notified.
 428 COND is the condition variable to wait on.
 429
 430 The mutex associated with COND must be held when this is called.
 431 It is an error if it is not held.
 432
 433 This releases the mutex and waits for COND to be notified or for
 434 this thread to be signaled with `thread-signal'.  When
 435 `condition-wait' returns, COND's mutex will again be locked by
 436 this thread.  */)
 437   (Lisp_Object cond)
 438 {
 439   struct Lisp_CondVar *cvar;
 440   struct Lisp_Mutex *mutex;
 441
 442   CHECK_CONDVAR (cond);
 443   cvar = XCONDVAR (cond);
 444
 445   mutex = XMUTEX (cvar->mutex);
 446   if (!lisp_mutex_owned_p (&mutex->mutex))
 447     error ("Condition variable's mutex is not held by current thread");
 448
 449   flush_stack_call_func (condition_wait_callback, cvar);
 450
 451   return Qnil;
 452 }
 453
 454 /* Used to communicate arguments to condition_notify_callback.  */
 455 struct notify_args
 456 {
 457   struct Lisp_CondVar *cvar;
 458   int all;
 459 };
 460
 461 static void
 462 condition_notify_callback (void *arg)
 463 {
 464   struct notify_args *na = arg;
 465   struct Lisp_Mutex *mutex = XMUTEX (na->cvar->mutex);
 466   struct thread_state *self = current_thread;
 467   unsigned int saved_count;
 468   Lisp_Object cond;
 469
 470   XSETCONDVAR (cond, na->cvar);
 471   saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex);
 472   if (na->all)
 473     sys_cond_broadcast (&na->cvar->cond);
 474   else
 475     sys_cond_signal (&na->cvar->cond);
 476   /* Calling lisp_mutex_lock might yield to other threads while this
 477      one waits for the mutex to become unlocked, so we need to
 478      announce us as the current thread by calling
 479      post_acquire_global_lock.  */
 480   lisp_mutex_lock (&mutex->mutex, saved_count);
 481   post_acquire_global_lock (self);
 482 }
 483
 484 DEFUN ("condition-notify", Fcondition_notify, Scondition_notify, 1, 2, 0,
 485        doc: /* Notify COND, a condition variable.
 486 This wakes a thread waiting on COND.
 487 If ALL is non-nil, all waiting threads are awoken.
 488
 489 The mutex associated with COND must be held when this is called.
 490 It is an error if it is not held.
 491
 492 This releases COND's mutex when notifying COND.  When
 493 `condition-notify' returns, the mutex will again be locked by this
 494 thread.  */)
 495   (Lisp_Object cond, Lisp_Object all)
 496 {
 497   struct Lisp_CondVar *cvar;
 498   struct Lisp_Mutex *mutex;
 499   struct notify_args args;
 500
 501   CHECK_CONDVAR (cond);
 502   cvar = XCONDVAR (cond);
 503
 504   mutex = XMUTEX (cvar->mutex);
 505   if (!lisp_mutex_owned_p (&mutex->mutex))
 506     error ("Condition variable's mutex is not held by current thread");
 507
 508   args.cvar = cvar;
 509   args.all = !NILP (all);
 510   flush_stack_call_func (condition_notify_callback, &args);
 511
 512   return Qnil;
 513 }
 514
 515 DEFUN ("condition-mutex", Fcondition_mutex, Scondition_mutex, 1, 1, 0,
 516        doc: /* Return the mutex associated with condition variable COND.  */)
 517   (Lisp_Object cond)
 518 {
 519   struct Lisp_CondVar *cvar;
 520
 521   CHECK_CONDVAR (cond);
 522   cvar = XCONDVAR (cond);
 523
 524   return cvar->mutex;
 525 }
 526
 527 DEFUN ("condition-name", Fcondition_name, Scondition_name, 1, 1, 0,
 528        doc: /* Return the name of condition variable COND.
 529 If no name was given when COND was created, return nil.  */)
 530   (Lisp_Object cond)
 531 {
 532   struct Lisp_CondVar *cvar;
 533
 534   CHECK_CONDVAR (cond);
 535   cvar = XCONDVAR (cond);
 536
 537   return cvar->name;
 538 }
 539
 540 void
 541 finalize_one_condvar (struct Lisp_CondVar *condvar)
 542 {
 543   sys_cond_destroy (&condvar->cond);
 544 }
 545
 546 \f
 547
 548 struct select_args
 549 {
 550   select_func *func;
 551   int max_fds;
 552   fd_set *rfds;
 553   fd_set *wfds;
 554   fd_set *efds;
 555   struct timespec *timeout;
 556   sigset_t *sigmask;
 557   int result;
 558 };
 559
 560 static void
 561 really_call_select (void *arg)
 562 {
 563   struct select_args *sa = arg;
 564   struct thread_state *self = current_thread;
 565   sigset_t oldset;
 566
 567   block_interrupt_signal (&oldset);
 568   self->not_holding_lock = 1;
 569   release_global_lock ();
 570   restore_signal_mask (&oldset);
 571
 572   sa->result = (sa->func) (sa->max_fds, sa->rfds, sa->wfds, sa->efds,
 573                            sa->timeout, sa->sigmask);
 574
 575   block_interrupt_signal (&oldset);
 576   acquire_global_lock (self);
 577   self->not_holding_lock = 0;
 578   restore_signal_mask (&oldset);
 579 }
 580
 581 int
 582 thread_select (select_func *func, int max_fds, fd_set *rfds,
 583                fd_set *wfds, fd_set *efds, struct timespec *timeout,
 584                sigset_t *sigmask)
 585 {
 586   struct select_args sa;
 587
 588   sa.func = func;
 589   sa.max_fds = max_fds;
 590   sa.rfds = rfds;
 591   sa.wfds = wfds;
 592   sa.efds = efds;
 593   sa.timeout = timeout;
 594   sa.sigmask = sigmask;
 595   flush_stack_call_func (really_call_select, &sa);
 596   return sa.result;
 597 }
 598
 599 \f
 600
 601 static void
 602 mark_one_thread (struct thread_state *thread)
 603 {
 604   /* Get the stack top now, in case mark_specpdl changes it.  */
 605   void *stack_top = thread->stack_top;
 606
 607   mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr);
 608
 609   mark_stack (thread->m_stack_bottom, stack_top);
 610
 611   for (struct handler *handler = thread->m_handlerlist;
 612        handler; handler = handler->next)
 613     {
 614       mark_object (handler->tag_or_ch);
 615       mark_object (handler->val);
 616     }
 617
 618   if (thread->m_current_buffer)
 619     {
 620       Lisp_Object tem;
 621       XSETBUFFER (tem, thread->m_current_buffer);
 622       mark_object (tem);
 623     }
 624
 625   mark_object (thread->m_last_thing_searched);
 626
 627   if (!NILP (thread->m_saved_last_thing_searched))
 628     mark_object (thread->m_saved_last_thing_searched);
 629 }
 630
 631 static void
 632 mark_threads_callback (void *ignore)
 633 {
 634   struct thread_state *iter;
 635
 636   for (iter = all_threads; iter; iter = iter->next_thread)
 637     {
 638       Lisp_Object thread_obj;
 639
 640       XSETTHREAD (thread_obj, iter);
 641       mark_object (thread_obj);
 642       mark_one_thread (iter);
 643     }
 644 }
 645
 646 void
 647 mark_threads (void)
 648 {
 649   flush_stack_call_func (mark_threads_callback, NULL);
 650 }
 651
 652 \f
 653
 654 static void
 655 yield_callback (void *ignore)
 656 {
 657   struct thread_state *self = current_thread;
 658
 659   release_global_lock ();
 660   sys_thread_yield ();
 661   acquire_global_lock (self);
 662 }
 663
 664 DEFUN ("thread-yield", Fthread_yield, Sthread_yield, 0, 0, 0,
 665        doc: /* Yield the CPU to another thread.  */)
 666      (void)
 667 {
 668   flush_stack_call_func (yield_callback, NULL);
 669   return Qnil;
 670 }
 671
 672 static Lisp_Object
 673 invoke_thread_function (void)
 674 {
 675   ptrdiff_t count = SPECPDL_INDEX ();
 676
 677   Ffuncall (1, &current_thread->function);
 678   return unbind_to (count, Qnil);
 679 }
 680
 681 static Lisp_Object last_thread_error;
 682
 683 static Lisp_Object
 684 record_thread_error (Lisp_Object error_form)
 685 {
 686   last_thread_error = error_form;
 687   return error_form;
 688 }
 689
 690 static void *
 691 run_thread (void *state)
 692 {
 693   /* Make sure stack_top and m_stack_bottom are properly aligned as GC
 694      expects.  */
 695   max_align_t stack_pos;
 696
 697   struct thread_state *self = state;
 698   struct thread_state **iter;
 699
 700   self->m_stack_bottom = self->stack_top = (char *) &stack_pos;
 701   self->thread_id = sys_thread_self ();
 702
 703   acquire_global_lock (self);
 704
 705   /* Put a dummy catcher at top-level so that handlerlist is never NULL.
 706      This is important since handlerlist->nextfree holds the freelist
 707      which would otherwise leak every time we unwind back to top-level.   */
 708   handlerlist_sentinel = xzalloc (sizeof (struct handler));
 709   handlerlist = handlerlist_sentinel->nextfree = handlerlist_sentinel;
 710   struct handler *c = push_handler (Qunbound, CATCHER);
 711   eassert (c == handlerlist_sentinel);
 712   handlerlist_sentinel->nextfree = NULL;
 713   handlerlist_sentinel->next = NULL;
 714
 715   /* It might be nice to do something with errors here.  */
 716   internal_condition_case (invoke_thread_function, Qt, record_thread_error);
 717
 718   update_processes_for_thread_death (Fcurrent_thread ());
 719
 720   xfree (self->m_specpdl - 1);
 721   self->m_specpdl = NULL;
 722   self->m_specpdl_ptr = NULL;
 723   self->m_specpdl_size = 0;
 724
 725   {
 726     struct handler *c, *c_next;
 727     for (c = handlerlist_sentinel; c; c = c_next)
 728       {
 729         c_next = c->nextfree;
 730         xfree (c);
 731       }
 732   }
 733
 734   current_thread = NULL;
 735   sys_cond_broadcast (&self->thread_condvar);
 736
 737   /* Unlink this thread from the list of all threads.  Note that we
 738      have to do this very late, after broadcasting our death.
 739      Otherwise the GC may decide to reap the thread_state object,
 740      leading to crashes.  */
 741   for (iter = &all_threads; *iter != self; iter = &(*iter)->next_thread)
 742     ;
 743   *iter = (*iter)->next_thread;
 744
 745   release_global_lock ();
 746
 747   return NULL;
 748 }
 749
 750 void
 751 finalize_one_thread (struct thread_state *state)
 752 {
 753   sys_cond_destroy (&state->thread_condvar);
 754 }
 755
 756 DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0,
 757        doc: /* Start a new thread and run FUNCTION in it.
 758 When the function exits, the thread dies.
 759 If NAME is given, it must be a string; it names the new thread.  */)
 760   (Lisp_Object function, Lisp_Object name)
 761 {
 762   sys_thread_t thr;
 763   struct thread_state *new_thread;
 764   Lisp_Object result;
 765   const char *c_name = NULL;
 766   size_t offset = offsetof (struct thread_state, m_stack_bottom);
 767
 768   /* Can't start a thread in temacs.  */
 769   if (!initialized)
 770     emacs_abort ();
 771
 772   if (!NILP (name))
 773     CHECK_STRING (name);
 774
 775   new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_stack_bottom,
 776                                       PVEC_THREAD);
 777   memset ((char *) new_thread + offset, 0,
 778           sizeof (struct thread_state) - offset);
 779
 780   new_thread->function = function;
 781   new_thread->name = name;
 782   new_thread->m_last_thing_searched = Qnil; /* copy from parent? */
 783   new_thread->m_saved_last_thing_searched = Qnil;
 784   new_thread->m_current_buffer = current_thread->m_current_buffer;
 785   new_thread->error_symbol = Qnil;
 786   new_thread->error_data = Qnil;
 787   new_thread->event_object = Qnil;
 788
 789   new_thread->m_specpdl_size = 50;
 790   new_thread->m_specpdl = xmalloc ((1 + new_thread->m_specpdl_size)
 791                                    * sizeof (union specbinding));
 792   /* Skip the dummy entry.  */
 793   ++new_thread->m_specpdl;
 794   new_thread->m_specpdl_ptr = new_thread->m_specpdl;
 795
 796   sys_cond_init (&new_thread->thread_condvar);
 797
 798   /* We'll need locking here eventually.  */
 799   new_thread->next_thread = all_threads;
 800   all_threads = new_thread;
 801
 802   if (!NILP (name))
 803     c_name = SSDATA (ENCODE_UTF_8 (name));
 804
 805   if (! sys_thread_create (&thr, c_name, run_thread, new_thread))
 806     {
 807       /* Restore the previous situation.  */
 808       all_threads = all_threads->next_thread;
 809       error ("Could not start a new thread");
 810     }
 811
 812   /* FIXME: race here where new thread might not be filled in?  */
 813   XSETTHREAD (result, new_thread);
 814   return result;
 815 }
 816
 817 DEFUN ("current-thread", Fcurrent_thread, Scurrent_thread, 0, 0, 0,
 818        doc: /* Return the current thread.  */)
 819   (void)
 820 {
 821   Lisp_Object result;
 822   XSETTHREAD (result, current_thread);
 823   return result;
 824 }
 825
 826 DEFUN ("thread-name", Fthread_name, Sthread_name, 1, 1, 0,
 827        doc: /* Return the name of the THREAD.
 828 The name is the same object that was passed to `make-thread'.  */)
 829      (Lisp_Object thread)
 830 {
 831   struct thread_state *tstate;
 832
 833   CHECK_THREAD (thread);
 834   tstate = XTHREAD (thread);
 835
 836   return tstate->name;
 837 }
 838
 839 static void
 840 thread_signal_callback (void *arg)
 841 {
 842   struct thread_state *tstate = arg;
 843   struct thread_state *self = current_thread;
 844
 845   sys_cond_broadcast (tstate->wait_condvar);
 846   post_acquire_global_lock (self);
 847 }
 848
 849 DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0,
 850        doc: /* Signal an error in a thread.
 851 This acts like `signal', but arranges for the signal to be raised
 852 in THREAD.  If THREAD is the current thread, acts just like `signal'.
 853 This will interrupt a blocked call to `mutex-lock', `condition-wait',
 854 or `thread-join' in the target thread.  */)
 855   (Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data)
 856 {
 857   struct thread_state *tstate;
 858
 859   CHECK_THREAD (thread);
 860   tstate = XTHREAD (thread);
 861
 862   if (tstate == current_thread)
 863     Fsignal (error_symbol, data);
 864
 865   /* What to do if thread is already signaled?  */
 866   /* What if error_symbol is Qnil?  */
 867   tstate->error_symbol = error_symbol;
 868   tstate->error_data = data;
 869
 870   if (tstate->wait_condvar)
 871     flush_stack_call_func (thread_signal_callback, tstate);
 872
 873   return Qnil;
 874 }
 875
 876 DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0,
 877        doc: /* Return t if THREAD is alive, or nil if it has exited.  */)
 878   (Lisp_Object thread)
 879 {
 880   struct thread_state *tstate;
 881
 882   CHECK_THREAD (thread);
 883   tstate = XTHREAD (thread);
 884
 885   return thread_alive_p (tstate) ? Qt : Qnil;
 886 }
 887
 888 DEFUN ("thread--blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0,
 889        doc: /* Return the object that THREAD is blocking on.
 890 If THREAD is blocked in `thread-join' on a second thread, return that
 891 thread.
 892 If THREAD is blocked in `mutex-lock', return the mutex.
 893 If THREAD is blocked in `condition-wait', return the condition variable.
 894 Otherwise, if THREAD is not blocked, return nil.  */)
 895   (Lisp_Object thread)
 896 {
 897   struct thread_state *tstate;
 898
 899   CHECK_THREAD (thread);
 900   tstate = XTHREAD (thread);
 901
 902   return tstate->event_object;
 903 }
 904
 905 static void
 906 thread_join_callback (void *arg)
 907 {
 908   struct thread_state *tstate = arg;
 909   struct thread_state *self = current_thread;
 910   Lisp_Object thread;
 911
 912   XSETTHREAD (thread, tstate);
 913   self->event_object = thread;
 914   self->wait_condvar = &tstate->thread_condvar;
 915   while (thread_alive_p (tstate) && NILP (self->error_symbol))
 916     sys_cond_wait (self->wait_condvar, &global_lock);
 917
 918   self->wait_condvar = NULL;
 919   self->event_object = Qnil;
 920   post_acquire_global_lock (self);
 921 }
 922
 923 DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0,
 924        doc: /* Wait for THREAD to exit.
 925 This blocks the current thread until THREAD exits or until
 926 the current thread is signaled.
 927 It is an error for a thread to try to join itself.  */)
 928   (Lisp_Object thread)
 929 {
 930   struct thread_state *tstate;
 931
 932   CHECK_THREAD (thread);
 933   tstate = XTHREAD (thread);
 934
 935   if (tstate == current_thread)
 936     error ("Cannot join current thread");
 937
 938   if (thread_alive_p (tstate))
 939     flush_stack_call_func (thread_join_callback, tstate);
 940
 941   return Qnil;
 942 }
 943
 944 DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
 945        doc: /* Return a list of all the live threads.  */)
 946   (void)
 947 {
 948   Lisp_Object result = Qnil;
 949   struct thread_state *iter;
 950
 951   for (iter = all_threads; iter; iter = iter->next_thread)
 952     {
 953       if (thread_alive_p (iter))
 954         {
 955           Lisp_Object thread;
 956
 957           XSETTHREAD (thread, iter);
 958           result = Fcons (thread, result);
 959         }
 960     }
 961
 962   return result;
 963 }
 964
 965 DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 0, 0,
 966        doc: /* Return the last error form recorded by a dying thread.  */)
 967   (void)
 968 {
 969   return last_thread_error;
 970 }
 971
 972 \f
 973
 974 bool
 975 thread_check_current_buffer (struct buffer *buffer)
 976 {
 977   struct thread_state *iter;
 978
 979   for (iter = all_threads; iter; iter = iter->next_thread)
 980     {
 981       if (iter == current_thread)
 982         continue;
 983
 984       if (iter->m_current_buffer == buffer)
 985         return true;
 986     }
 987
 988   return false;
 989 }
 990
 991 \f
 992
 993 static void
 994 init_main_thread (void)
 995 {
 996   main_thread.header.size
 997     = PSEUDOVECSIZE (struct thread_state, m_stack_bottom);
 998   XSETPVECTYPE (&main_thread, PVEC_THREAD);
 999   main_thread.m_last_thing_searched = Qnil;
1000   main_thread.m_saved_last_thing_searched = Qnil;
1001   main_thread.name = Qnil;
1002   main_thread.function = Qnil;
1003   main_thread.error_symbol = Qnil;
1004   main_thread.error_data = Qnil;
1005   main_thread.event_object = Qnil;
1006 }
1007
1008 bool
1009 main_thread_p (void *ptr)
1010 {
1011   return ptr == &main_thread;
1012 }
1013
1014 void
1015 init_threads_once (void)
1016 {
1017   init_main_thread ();
1018 }
1019
1020 void
1021 init_threads (void)
1022 {
1023   init_main_thread ();
1024   sys_cond_init (&main_thread.thread_condvar);
1025   sys_mutex_init (&global_lock);
1026   sys_mutex_lock (&global_lock);
1027   current_thread = &main_thread;
1028   main_thread.thread_id = sys_thread_self ();
1029 }
1030
1031 void
1032 syms_of_threads (void)
1033 {
1034 #ifndef THREADS_ENABLED
1035   if (0)
1036 #endif
1037     {
1038       defsubr (&Sthread_yield);
1039       defsubr (&Smake_thread);
1040       defsubr (&Scurrent_thread);
1041       defsubr (&Sthread_name);
1042       defsubr (&Sthread_signal);
1043       defsubr (&Sthread_alive_p);
1044       defsubr (&Sthread_join);
1045       defsubr (&Sthread_blocker);
1046       defsubr (&Sall_threads);
1047       defsubr (&Smake_mutex);
1048       defsubr (&Smutex_lock);
1049       defsubr (&Smutex_unlock);
1050       defsubr (&Smutex_name);
1051       defsubr (&Smake_condition_variable);
1052       defsubr (&Scondition_wait);
1053       defsubr (&Scondition_notify);
1054       defsubr (&Scondition_mutex);
1055       defsubr (&Scondition_name);
1056       defsubr (&Sthread_last_error);
1057
1058       staticpro (&last_thread_error);
1059       last_thread_error = Qnil;
1060     }
1061
1062   DEFSYM (Qthreadp, "threadp");
1063   DEFSYM (Qmutexp, "mutexp");
1064   DEFSYM (Qcondition_variable_p, "condition-variable-p");
1065 }