thread.c 27.4 KB
Newer Older
1
/* Threading code.
2
Copyright (C) 2012-2017 Free Software Foundation, Inc.
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */


#include <config.h>
#include <setjmp.h>
#include "lisp.h"
23 24
#include "character.h"
#include "buffer.h"
Tom Tromey's avatar
Tom Tromey committed
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

Tom Tromey's avatar
Tom Tromey committed
35
static sys_mutex_t global_lock;
36

Ken Raeburn's avatar
Ken Raeburn committed
37 38
extern int poll_suppress_count;
extern volatile int interrupt_input_blocked;
39 40 41



Tom Tromey's avatar
Tom Tromey committed
42 43 44 45 46 47
/* m_specpdl is set when the thread is created and cleared when the
   thread dies.  */
#define thread_alive_p(STATE) ((STATE)->m_specpdl != NULL)



Tom Tromey's avatar
Tom Tromey committed
48 49 50 51 52 53 54 55 56 57 58
static void
release_global_lock (void)
{
  sys_mutex_unlock (&global_lock);
}

/* You must call this after acquiring the global lock.
   acquire_global_lock does it for you.  */
static void
post_acquire_global_lock (struct thread_state *self)
{
59
  struct thread_state *prev_thread = current_thread;
Tom Tromey's avatar
Tom Tromey committed
60

61 62 63 64 65 66
  /* Do this early on, so that code below could signal errors (e.g.,
     unbind_for_thread_switch might) correctly, because we are already
     running in the context of the thread pointed by SELF.  */
  current_thread = self;

  if (prev_thread != current_thread)
Tom Tromey's avatar
Tom Tromey committed
67
    {
68
      /* PREV_THREAD is NULL if the previously current thread
69 70
	 exited.  In this case, there is no reason to unbind, and
	 trying will crash.  */
71 72
      if (prev_thread != NULL)
	unbind_for_thread_switch (prev_thread);
Tom Tromey's avatar
Tom Tromey committed
73 74
      rebind_for_thread_switch ();

75 76 77 78 79
       /* Set the new thread's current buffer.  This needs to be done
	  even if it is the same buffer as that of the previous thread,
	  because of thread-local bindings.  */
      set_buffer_internal_2 (current_buffer);
    }
Tom Tromey's avatar
Tom Tromey committed
80

81 82 83 84 85 86
   /* We could have been signaled while waiting to grab the global lock
      for the first time since this thread was created, in which case
      we didn't yet have the opportunity to set up the handlers.  Delay
      raising the signal in that case (it will be actually raised when
      the thread comes here after acquiring the lock the next time).  */
  if (!NILP (current_thread->error_symbol) && handlerlist)
Tom Tromey's avatar
Tom Tromey committed
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
    {
      Lisp_Object sym = current_thread->error_symbol;
      Lisp_Object data = current_thread->error_data;

      current_thread->error_symbol = Qnil;
      current_thread->error_data = Qnil;
      Fsignal (sym, data);
    }
}

static void
acquire_global_lock (struct thread_state *self)
{
  sys_mutex_lock (&global_lock);
  post_acquire_global_lock (self);
}

104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
/* This is called from keyboard.c when it detects that SIGINT
   interrupted thread_select before the current thread could acquire
   the lock.  We must acquire the lock to prevent a thread from
   running without holding the global lock, and to avoid repeated
   calls to sys_mutex_unlock, which invokes undefined behavior.  */
void
maybe_reacquire_global_lock (void)
{
  if (current_thread->not_holding_lock)
    {
      struct thread_state *self = current_thread;

      acquire_global_lock (self);
      current_thread->not_holding_lock = 0;
    }
}

Tom Tromey's avatar
Tom Tromey committed
121 122 123 124 125 126 127 128 129 130


static void
lisp_mutex_init (lisp_mutex_t *mutex)
{
  mutex->owner = NULL;
  mutex->count = 0;
  sys_cond_init (&mutex->condition);
}

131 132
/* Lock MUTEX for thread LOCKER, setting its lock count to COUNT, if
   non-zero, or to 1 otherwise.
133

134 135
   If MUTEX is locked by LOCKER, COUNT must be zero, and the MUTEX's
   lock count will be incremented.
136 137 138 139 140 141 142 143 144

   If MUTEX is locked by another thread, this function will release
   the global lock, giving other threads a chance to run, and will
   wait for the MUTEX to become unlocked; when MUTEX becomes unlocked,
   and will then re-acquire the global lock.

   Return value is 1 if the function waited for the MUTEX to become
   unlocked (meaning other threads could have run during the wait),
   zero otherwise.  */
Tom Tromey's avatar
Tom Tromey committed
145
static int
146 147
lisp_mutex_lock_for_thread (lisp_mutex_t *mutex, struct thread_state *locker,
			    int new_count)
Tom Tromey's avatar
Tom Tromey committed
148 149 150 151 152
{
  struct thread_state *self;

  if (mutex->owner == NULL)
    {
153
      mutex->owner = locker;
Tom Tromey's avatar
Tom Tromey committed
154 155
      mutex->count = new_count == 0 ? 1 : new_count;
      return 0;
Tom Tromey's avatar
Tom Tromey committed
156
    }
157
  if (mutex->owner == locker)
Tom Tromey's avatar
Tom Tromey committed
158
    {
Tom Tromey's avatar
Tom Tromey committed
159
      eassert (new_count == 0);
Tom Tromey's avatar
Tom Tromey committed
160
      ++mutex->count;
Tom Tromey's avatar
Tom Tromey committed
161
      return 0;
Tom Tromey's avatar
Tom Tromey committed
162 163
    }

164
  self = locker;
Tom Tromey's avatar
Tom Tromey committed
165
  self->wait_condvar = &mutex->condition;
Tom Tromey's avatar
Tom Tromey committed
166
  while (mutex->owner != NULL && (new_count != 0
Tom Tromey's avatar
Tom Tromey committed
167
				  || NILP (self->error_symbol)))
Tom Tromey's avatar
Tom Tromey committed
168 169 170
    sys_cond_wait (&mutex->condition, &global_lock);
  self->wait_condvar = NULL;

Tom Tromey's avatar
Tom Tromey committed
171 172
  if (new_count == 0 && !NILP (self->error_symbol))
    return 1;
Tom Tromey's avatar
Tom Tromey committed
173 174

  mutex->owner = self;
Tom Tromey's avatar
Tom Tromey committed
175 176 177
  mutex->count = new_count == 0 ? 1 : new_count;

  return 1;
Tom Tromey's avatar
Tom Tromey committed
178 179
}

180 181 182 183 184 185
static int
lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
{
  return lisp_mutex_lock_for_thread (mutex, current_thread, new_count);
}

186 187 188 189 190 191
/* Decrement MUTEX's lock count.  If the lock count becomes zero after
   decrementing it, meaning the mutex is now unlocked, broadcast that
   to all the threads that might be waiting to lock the mutex.  This
   function signals an error if MUTEX is locked by a thread other than
   the current one.  Return value is 1 if the mutex becomes unlocked,
   zero otherwise.  */
Tom Tromey's avatar
Tom Tromey committed
192
static int
Tom Tromey's avatar
Tom Tromey committed
193 194 195
lisp_mutex_unlock (lisp_mutex_t *mutex)
{
  if (mutex->owner != current_thread)
Eli Zaretskii's avatar
Eli Zaretskii committed
196
    error ("Cannot unlock mutex owned by another thread");
Tom Tromey's avatar
Tom Tromey committed
197 198

  if (--mutex->count > 0)
Tom Tromey's avatar
Tom Tromey committed
199
    return 0;
Tom Tromey's avatar
Tom Tromey committed
200 201 202 203

  mutex->owner = NULL;
  sys_cond_broadcast (&mutex->condition);

Tom Tromey's avatar
Tom Tromey committed
204 205 206
  return 1;
}

207 208
/* Like lisp_mutex_unlock, but sets MUTEX's lock count to zero
   regardless of its value.  Return the previous lock count.  */
Tom Tromey's avatar
Tom Tromey committed
209 210 211 212 213 214 215 216 217 218 219 220 221
static unsigned int
lisp_mutex_unlock_for_wait (lisp_mutex_t *mutex)
{
  unsigned int result = mutex->count;

  /* Ensured by condvar code.  */
  eassert (mutex->owner == current_thread);

  mutex->count = 0;
  mutex->owner = NULL;
  sys_cond_broadcast (&mutex->condition);

  return result;
Tom Tromey's avatar
Tom Tromey committed
222 223 224 225 226 227 228 229
}

static void
lisp_mutex_destroy (lisp_mutex_t *mutex)
{
  sys_cond_destroy (&mutex->condition);
}

Tom Tromey's avatar
Tom Tromey committed
230 231 232 233 234 235
static int
lisp_mutex_owned_p (lisp_mutex_t *mutex)
{
  return mutex->owner == current_thread;
}

Tom Tromey's avatar
Tom Tromey committed
236 237


238
DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 1, 0,
239 240 241 242 243 244 245 246 247
       doc: /* Create a mutex.
A mutex provides a synchronization point for threads.
Only one thread at a time can hold a mutex.  Other threads attempting
to acquire it will block until the mutex is available.

A thread can acquire a mutex any number of times.

NAME, if given, is used as the name of the mutex.  The name is
informational only.  */)
248
  (Lisp_Object name)
249 250 251 252
{
  struct Lisp_Mutex *mutex;
  Lisp_Object result;

253 254 255
  if (!NILP (name))
    CHECK_STRING (name);

256 257 258 259
  mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, mutex, PVEC_MUTEX);
  memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex),
	  0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex,
						    mutex));
260
  mutex->name = name;
261 262 263 264 265 266 267 268 269 270
  lisp_mutex_init (&mutex->mutex);

  XSETMUTEX (result, mutex);
  return result;
}

static void
mutex_lock_callback (void *arg)
{
  struct Lisp_Mutex *mutex = arg;
Tom Tromey's avatar
Tom Tromey committed
271
  struct thread_state *self = current_thread;
272

273 274 275 276
  /* Calling lisp_mutex_lock might yield to other threads while this
     one waits for the mutex to become unlocked, so we need to
     announce us as the current thread by calling
     post_acquire_global_lock.  */
Tom Tromey's avatar
Tom Tromey committed
277 278
  if (lisp_mutex_lock (&mutex->mutex, 0))
    post_acquire_global_lock (self);
279 280
}

281 282
static void
do_unwind_mutex_lock (void)
283 284 285 286
{
  current_thread->event_object = Qnil;
}

287
DEFUN ("mutex-lock", Fmutex_lock, Smutex_lock, 1, 1, 0,
288 289 290 291 292
       doc: /* Acquire a mutex.
If the current thread already owns MUTEX, increment the count and
return.
Otherwise, if no thread owns MUTEX, make the current thread own it.
Otherwise, block until MUTEX is available, or until the current thread
Paul Eggert's avatar
Paul Eggert committed
293
is signaled using `thread-signal'.
294 295 296 297
Note that calls to `mutex-lock' and `mutex-unlock' must be paired.  */)
  (Lisp_Object mutex)
{
  struct Lisp_Mutex *lmutex;
298
  ptrdiff_t count = SPECPDL_INDEX ();
299

300 301
  CHECK_MUTEX (mutex);
  lmutex = XMUTEX (mutex);
302

303
  current_thread->event_object = mutex;
304
  record_unwind_protect_void (do_unwind_mutex_lock);
305
  flush_stack_call_func (mutex_lock_callback, lmutex);
306
  return unbind_to (count, Qnil);
307 308 309 310 311 312
}

static void
mutex_unlock_callback (void *arg)
{
  struct Lisp_Mutex *mutex = arg;
Tom Tromey's avatar
Tom Tromey committed
313
  struct thread_state *self = current_thread;
314

Tom Tromey's avatar
Tom Tromey committed
315
  if (lisp_mutex_unlock (&mutex->mutex))
316
    post_acquire_global_lock (self); /* FIXME: is this call needed? */
317 318 319
}

DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0,
320
       doc: /* Release the mutex.
Ken Raeburn's avatar
Ken Raeburn committed
321
If this thread does not own MUTEX, signal an error.
322 323 324
Otherwise, decrement the mutex's count.  If the count is zero,
release MUTEX.   */)
  (Lisp_Object mutex)
325
{
326
  struct Lisp_Mutex *lmutex;
327

328 329
  CHECK_MUTEX (mutex);
  lmutex = XMUTEX (mutex);
330

331
  flush_stack_call_func (mutex_unlock_callback, lmutex);
332 333 334
  return Qnil;
}

335
DEFUN ("mutex-name", Fmutex_name, Smutex_name, 1, 1, 0,
336 337 338
       doc: /* Return the name of MUTEX.
If no name was given when MUTEX was created, return nil.  */)
  (Lisp_Object mutex)
339
{
340
  struct Lisp_Mutex *lmutex;
341

342 343
  CHECK_MUTEX (mutex);
  lmutex = XMUTEX (mutex);
344

345
  return lmutex->name;
346 347
}

348 349 350 351 352
void
finalize_one_mutex (struct Lisp_Mutex *mutex)
{
  lisp_mutex_destroy (&mutex->mutex);
}
353 354 355



Tom Tromey's avatar
Tom Tromey committed
356 357 358
DEFUN ("make-condition-variable",
       Fmake_condition_variable, Smake_condition_variable,
       1, 2, 0,
359
       doc: /* Make a condition variable associated with MUTEX.
Tom Tromey's avatar
Tom Tromey committed
360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
A condition variable provides a way for a thread to sleep while
waiting for a state change.

MUTEX is the mutex associated with this condition variable.
NAME, if given, is the name of this condition variable.  The name is
informational only.  */)
  (Lisp_Object mutex, Lisp_Object name)
{
  struct Lisp_CondVar *condvar;
  Lisp_Object result;

  CHECK_MUTEX (mutex);
  if (!NILP (name))
    CHECK_STRING (name);

  condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, cond, PVEC_CONDVAR);
  memset ((char *) condvar + offsetof (struct Lisp_CondVar, cond),
	  0, sizeof (struct Lisp_CondVar) - offsetof (struct Lisp_CondVar,
						      cond));
  condvar->mutex = mutex;
  condvar->name = name;
  sys_cond_init (&condvar->cond);

  XSETCONDVAR (result, condvar);
  return result;
}

static void
condition_wait_callback (void *arg)
{
  struct Lisp_CondVar *cvar = arg;
  struct Lisp_Mutex *mutex = XMUTEX (cvar->mutex);
  struct thread_state *self = current_thread;
  unsigned int saved_count;
  Lisp_Object cond;

  XSETCONDVAR (cond, cvar);
Tom Tromey's avatar
Tom Tromey committed
397
  self->event_object = cond;
Tom Tromey's avatar
Tom Tromey committed
398
  saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex);
Paul Eggert's avatar
Paul Eggert committed
399
  /* If signaled while unlocking, skip the wait but reacquire the lock.  */
Tom Tromey's avatar
Tom Tromey committed
400 401 402
  if (NILP (self->error_symbol))
    {
      self->wait_condvar = &cvar->cond;
403
      /* This call could switch to another thread.  */
Tom Tromey's avatar
Tom Tromey committed
404 405 406
      sys_cond_wait (&cvar->cond, &global_lock);
      self->wait_condvar = NULL;
    }
Tom Tromey's avatar
Tom Tromey committed
407
  self->event_object = Qnil;
408 409 410 411 412 413 414 415
  /* Since sys_cond_wait could switch threads, we need to lock the
     mutex for the thread which was the current when we were called,
     otherwise lisp_mutex_lock will record the wrong thread as the
     owner of the mutex lock.  */
  lisp_mutex_lock_for_thread (&mutex->mutex, self, saved_count);
  /* Calling lisp_mutex_lock_for_thread might yield to other threads
     while this one waits for the mutex to become unlocked, so we need
     to announce us as the current thread by calling
416
     post_acquire_global_lock.  */
417
  post_acquire_global_lock (self);
Tom Tromey's avatar
Tom Tromey committed
418 419 420
}

DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0,
421 422
       doc: /* Wait for the condition variable COND to be notified.
COND is the condition variable to wait on.
Tom Tromey's avatar
Tom Tromey committed
423

424
The mutex associated with COND must be held when this is called.
Tom Tromey's avatar
Tom Tromey committed
425 426
It is an error if it is not held.

427
This releases the mutex and waits for COND to be notified or for
Paul Eggert's avatar
Paul Eggert committed
428
this thread to be signaled with `thread-signal'.  When
429 430 431
`condition-wait' returns, COND's mutex will again be locked by
this thread.  */)
  (Lisp_Object cond)
Tom Tromey's avatar
Tom Tromey committed
432 433 434 435
{
  struct Lisp_CondVar *cvar;
  struct Lisp_Mutex *mutex;

436 437
  CHECK_CONDVAR (cond);
  cvar = XCONDVAR (cond);
Tom Tromey's avatar
Tom Tromey committed
438 439 440

  mutex = XMUTEX (cvar->mutex);
  if (!lisp_mutex_owned_p (&mutex->mutex))
Eli Zaretskii's avatar
Eli Zaretskii committed
441
    error ("Condition variable's mutex is not held by current thread");
Tom Tromey's avatar
Tom Tromey committed
442 443 444 445 446 447

  flush_stack_call_func (condition_wait_callback, cvar);

  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
448
/* Used to communicate arguments to condition_notify_callback.  */
Tom Tromey's avatar
Tom Tromey committed
449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469
struct notify_args
{
  struct Lisp_CondVar *cvar;
  int all;
};

static void
condition_notify_callback (void *arg)
{
  struct notify_args *na = arg;
  struct Lisp_Mutex *mutex = XMUTEX (na->cvar->mutex);
  struct thread_state *self = current_thread;
  unsigned int saved_count;
  Lisp_Object cond;

  XSETCONDVAR (cond, na->cvar);
  saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex);
  if (na->all)
    sys_cond_broadcast (&na->cvar->cond);
  else
    sys_cond_signal (&na->cvar->cond);
470 471 472 473
  /* Calling lisp_mutex_lock might yield to other threads while this
     one waits for the mutex to become unlocked, so we need to
     announce us as the current thread by calling
     post_acquire_global_lock.  */
Tom Tromey's avatar
Tom Tromey committed
474 475 476 477 478
  lisp_mutex_lock (&mutex->mutex, saved_count);
  post_acquire_global_lock (self);
}

DEFUN ("condition-notify", Fcondition_notify, Scondition_notify, 1, 2, 0,
479 480
       doc: /* Notify COND, a condition variable.
This wakes a thread waiting on COND.
Tom Tromey's avatar
Tom Tromey committed
481 482
If ALL is non-nil, all waiting threads are awoken.

483
The mutex associated with COND must be held when this is called.
Tom Tromey's avatar
Tom Tromey committed
484 485
It is an error if it is not held.

486
This releases COND's mutex when notifying COND.  When
Tom Tromey's avatar
Tom Tromey committed
487 488
`condition-notify' returns, the mutex will again be locked by this
thread.  */)
489
  (Lisp_Object cond, Lisp_Object all)
Tom Tromey's avatar
Tom Tromey committed
490 491 492 493 494
{
  struct Lisp_CondVar *cvar;
  struct Lisp_Mutex *mutex;
  struct notify_args args;

495 496
  CHECK_CONDVAR (cond);
  cvar = XCONDVAR (cond);
Tom Tromey's avatar
Tom Tromey committed
497 498 499

  mutex = XMUTEX (cvar->mutex);
  if (!lisp_mutex_owned_p (&mutex->mutex))
Eli Zaretskii's avatar
Eli Zaretskii committed
500
    error ("Condition variable's mutex is not held by current thread");
Tom Tromey's avatar
Tom Tromey committed
501 502 503 504 505 506 507 508

  args.cvar = cvar;
  args.all = !NILP (all);
  flush_stack_call_func (condition_notify_callback, &args);

  return Qnil;
}

509
DEFUN ("condition-mutex", Fcondition_mutex, Scondition_mutex, 1, 1, 0,
510 511
       doc: /* Return the mutex associated with condition variable COND.  */)
  (Lisp_Object cond)
512 513 514
{
  struct Lisp_CondVar *cvar;

515 516
  CHECK_CONDVAR (cond);
  cvar = XCONDVAR (cond);
517 518 519 520 521

  return cvar->mutex;
}

DEFUN ("condition-name", Fcondition_name, Scondition_name, 1, 1, 0,
522 523 524
       doc: /* Return the name of condition variable COND.
If no name was given when COND was created, return nil.  */)
  (Lisp_Object cond)
525 526 527
{
  struct Lisp_CondVar *cvar;

528 529
  CHECK_CONDVAR (cond);
  cvar = XCONDVAR (cond);
530 531 532 533

  return cvar->name;
}

Tom Tromey's avatar
Tom Tromey committed
534 535 536 537 538 539 540 541
void
finalize_one_condvar (struct Lisp_CondVar *condvar)
{
  sys_cond_destroy (&condvar->cond);
}



Tom Tromey's avatar
Tom Tromey committed
542 543 544 545
struct select_args
{
  select_func *func;
  int max_fds;
Ken Raeburn's avatar
Ken Raeburn committed
546 547 548 549
  fd_set *rfds;
  fd_set *wfds;
  fd_set *efds;
  struct timespec *timeout;
Tom Tromey's avatar
Tom Tromey committed
550 551 552 553 554 555 556 557 558
  sigset_t *sigmask;
  int result;
};

static void
really_call_select (void *arg)
{
  struct select_args *sa = arg;
  struct thread_state *self = current_thread;
559
  sigset_t oldset;
Tom Tromey's avatar
Tom Tromey committed
560

561 562
  block_interrupt_signal (&oldset);
  self->not_holding_lock = 1;
Tom Tromey's avatar
Tom Tromey committed
563
  release_global_lock ();
564 565
  restore_signal_mask (&oldset);

Tom Tromey's avatar
Tom Tromey committed
566 567
  sa->result = (sa->func) (sa->max_fds, sa->rfds, sa->wfds, sa->efds,
			   sa->timeout, sa->sigmask);
568 569

  block_interrupt_signal (&oldset);
Tom Tromey's avatar
Tom Tromey committed
570
  acquire_global_lock (self);
571 572
  self->not_holding_lock = 0;
  restore_signal_mask (&oldset);
Tom Tromey's avatar
Tom Tromey committed
573 574 575
}

int
Ken Raeburn's avatar
Ken Raeburn committed
576 577
thread_select (select_func *func, int max_fds, fd_set *rfds,
	       fd_set *wfds, fd_set *efds, struct timespec *timeout,
Tom Tromey's avatar
Tom Tromey committed
578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594
	       sigset_t *sigmask)
{
  struct select_args sa;

  sa.func = func;
  sa.max_fds = max_fds;
  sa.rfds = rfds;
  sa.wfds = wfds;
  sa.efds = efds;
  sa.timeout = timeout;
  sa.sigmask = sigmask;
  flush_stack_call_func (really_call_select, &sa);
  return sa.result;
}



595 596 597
static void
mark_one_thread (struct thread_state *thread)
{
598 599
  /* Get the stack top now, in case mark_specpdl changes it.  */
  void *stack_top = thread->stack_top;
600

601
  mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr);
602

603
  mark_stack (thread->m_stack_bottom, stack_top);
604

605 606
  for (struct handler *handler = thread->m_handlerlist;
       handler; handler = handler->next)
607
    {
Ken Raeburn's avatar
Ken Raeburn committed
608 609
      mark_object (handler->tag_or_ch);
      mark_object (handler->val);
610 611 612 613
    }

  if (thread->m_current_buffer)
    {
614
      Lisp_Object tem;
615 616 617 618 619 620
      XSETBUFFER (tem, thread->m_current_buffer);
      mark_object (tem);
    }

  mark_object (thread->m_last_thing_searched);

621
  if (!NILP (thread->m_saved_last_thing_searched))
622 623 624 625 626 627 628 629 630
    mark_object (thread->m_saved_last_thing_searched);
}

static void
mark_threads_callback (void *ignore)
{
  struct thread_state *iter;

  for (iter = all_threads; iter; iter = iter->next_thread)
631 632 633 634 635 636 637
    {
      Lisp_Object thread_obj;

      XSETTHREAD (thread_obj, iter);
      mark_object (thread_obj);
      mark_one_thread (iter);
    }
638 639 640 641 642 643 644 645
}

void
mark_threads (void)
{
  flush_stack_call_func (mark_threads_callback, NULL);
}

646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668


static void
yield_callback (void *ignore)
{
  struct thread_state *self = current_thread;

  release_global_lock ();
  sys_thread_yield ();
  acquire_global_lock (self);
}

DEFUN ("thread-yield", Fthread_yield, Sthread_yield, 0, 0, 0,
       doc: /* Yield the CPU to another thread.  */)
     (void)
{
  flush_stack_call_func (yield_callback, NULL);
  return Qnil;
}

static Lisp_Object
invoke_thread_function (void)
{
669
  ptrdiff_t count = SPECPDL_INDEX ();
670 671 672 673 674

  Ffuncall (1, &current_thread->function);
  return unbind_to (count, Qnil);
}

675 676
static Lisp_Object last_thread_error;

677
static Lisp_Object
678
record_thread_error (Lisp_Object error_form)
679
{
680 681
  last_thread_error = error_form;
  return error_form;
682 683 684 685 686
}

static void *
run_thread (void *state)
{
687 688
  /* Make sure stack_top and m_stack_bottom are properly aligned as GC
     expects.  */
689
  max_align_t stack_pos;
690

691 692 693
  struct thread_state *self = state;
  struct thread_state **iter;

694
  self->m_stack_bottom = self->stack_top = (char *) &stack_pos;
695 696 697 698
  self->thread_id = sys_thread_self ();

  acquire_global_lock (self);

699 700 701 702 703 704 705 706 707
  /* Put a dummy catcher at top-level so that handlerlist is never NULL.
     This is important since handlerlist->nextfree holds the freelist
     which would otherwise leak every time we unwind back to top-level.   */
  handlerlist_sentinel = xzalloc (sizeof (struct handler));
  handlerlist = handlerlist_sentinel->nextfree = handlerlist_sentinel;
  struct handler *c = push_handler (Qunbound, CATCHER);
  eassert (c == handlerlist_sentinel);
  handlerlist_sentinel->nextfree = NULL;
  handlerlist_sentinel->next = NULL;
Ken Raeburn's avatar
Ken Raeburn committed
708

709
  /* It might be nice to do something with errors here.  */
710
  internal_condition_case (invoke_thread_function, Qt, record_thread_error);
711

Tom Tromey's avatar
Tom Tromey committed
712 713
  update_processes_for_thread_death (Fcurrent_thread ());

Tom Tromey's avatar
Tom Tromey committed
714
  xfree (self->m_specpdl - 1);
715 716 717 718
  self->m_specpdl = NULL;
  self->m_specpdl_ptr = NULL;
  self->m_specpdl_size = 0;

Ken Raeburn's avatar
Ken Raeburn committed
719 720 721 722 723 724 725 726 727
  {
    struct handler *c, *c_next;
    for (c = handlerlist_sentinel; c; c = c_next)
      {
	c_next = c->nextfree;
	xfree (c);
      }
  }

728
  current_thread = NULL;
729 730
  sys_cond_broadcast (&self->thread_condvar);

Tom Tromey's avatar
Tom Tromey committed
731 732 733 734 735 736 737 738
  /* Unlink this thread from the list of all threads.  Note that we
     have to do this very late, after broadcasting our death.
     Otherwise the GC may decide to reap the thread_state object,
     leading to crashes.  */
  for (iter = &all_threads; *iter != self; iter = &(*iter)->next_thread)
    ;
  *iter = (*iter)->next_thread;

739 740 741 742 743
  release_global_lock ();

  return NULL;
}

744
void
745
finalize_one_thread (struct thread_state *state)
746
{
747 748 749 750 751 752
  sys_cond_destroy (&state->thread_condvar);
}

DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0,
       doc: /* Start a new thread and run FUNCTION in it.
When the function exits, the thread dies.
753
If NAME is given, it must be a string; it names the new thread.  */)
754 755 756 757 758
  (Lisp_Object function, Lisp_Object name)
{
  sys_thread_t thr;
  struct thread_state *new_thread;
  Lisp_Object result;
759
  const char *c_name = NULL;
760
  size_t offset = offsetof (struct thread_state, m_stack_bottom);
761 762 763

  /* Can't start a thread in temacs.  */
  if (!initialized)
Eli Zaretskii's avatar
Eli Zaretskii committed
764
    emacs_abort ();
765

766 767 768
  if (!NILP (name))
    CHECK_STRING (name);

769
  new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_stack_bottom,
770
				      PVEC_THREAD);
Ken Raeburn's avatar
Ken Raeburn committed
771 772
  memset ((char *) new_thread + offset, 0,
	  sizeof (struct thread_state) - offset);
773 774 775 776 777 778 779 780

  new_thread->function = function;
  new_thread->name = name;
  new_thread->m_last_thing_searched = Qnil; /* copy from parent? */
  new_thread->m_saved_last_thing_searched = Qnil;
  new_thread->m_current_buffer = current_thread->m_current_buffer;
  new_thread->error_symbol = Qnil;
  new_thread->error_data = Qnil;
781
  new_thread->event_object = Qnil;
782 783

  new_thread->m_specpdl_size = 50;
Tom Tromey's avatar
Tom Tromey committed
784 785 786 787
  new_thread->m_specpdl = xmalloc ((1 + new_thread->m_specpdl_size)
				   * sizeof (union specbinding));
  /* Skip the dummy entry.  */
  ++new_thread->m_specpdl;
788 789 790 791 792 793 794 795
  new_thread->m_specpdl_ptr = new_thread->m_specpdl;

  sys_cond_init (&new_thread->thread_condvar);

  /* We'll need locking here eventually.  */
  new_thread->next_thread = all_threads;
  all_threads = new_thread;

796 797 798 799
  if (!NILP (name))
    c_name = SSDATA (ENCODE_UTF_8 (name));

  if (! sys_thread_create (&thr, c_name, run_thread, new_thread))
800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843
    {
      /* Restore the previous situation.  */
      all_threads = all_threads->next_thread;
      error ("Could not start a new thread");
    }

  /* FIXME: race here where new thread might not be filled in?  */
  XSETTHREAD (result, new_thread);
  return result;
}

DEFUN ("current-thread", Fcurrent_thread, Scurrent_thread, 0, 0, 0,
       doc: /* Return the current thread.  */)
  (void)
{
  Lisp_Object result;
  XSETTHREAD (result, current_thread);
  return result;
}

DEFUN ("thread-name", Fthread_name, Sthread_name, 1, 1, 0,
       doc: /* Return the name of the THREAD.
The name is the same object that was passed to `make-thread'.  */)
     (Lisp_Object thread)
{
  struct thread_state *tstate;

  CHECK_THREAD (thread);
  tstate = XTHREAD (thread);

  return tstate->name;
}

static void
thread_signal_callback (void *arg)
{
  struct thread_state *tstate = arg;
  struct thread_state *self = current_thread;

  sys_cond_broadcast (tstate->wait_condvar);
  post_acquire_global_lock (self);
}

DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0,
844 845 846
       doc: /* Signal an error in a thread.
This acts like `signal', but arranges for the signal to be raised
in THREAD.  If THREAD is the current thread, acts just like `signal'.
Tom Tromey's avatar
Tom Tromey committed
847 848
This will interrupt a blocked call to `mutex-lock', `condition-wait',
or `thread-join' in the target thread.  */)
849 850 851 852 853 854 855 856 857 858
  (Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data)
{
  struct thread_state *tstate;

  CHECK_THREAD (thread);
  tstate = XTHREAD (thread);

  if (tstate == current_thread)
    Fsignal (error_symbol, data);

Paul Eggert's avatar
Paul Eggert committed
859
  /* What to do if thread is already signaled?  */
860 861 862 863 864 865 866 867 868 869 870
  /* What if error_symbol is Qnil?  */
  tstate->error_symbol = error_symbol;
  tstate->error_data = data;

  if (tstate->wait_condvar)
    flush_stack_call_func (thread_signal_callback, tstate);

  return Qnil;
}

DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0,
871
       doc: /* Return t if THREAD is alive, or nil if it has exited.  */)
872 873 874 875 876 877 878
  (Lisp_Object thread)
{
  struct thread_state *tstate;

  CHECK_THREAD (thread);
  tstate = XTHREAD (thread);

Tom Tromey's avatar
Tom Tromey committed
879
  return thread_alive_p (tstate) ? Qt : Qnil;
880 881
}

882
DEFUN ("thread--blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0,
883 884 885 886
       doc: /* Return the object that THREAD is blocking on.
If THREAD is blocked in `thread-join' on a second thread, return that
thread.
If THREAD is blocked in `mutex-lock', return the mutex.
Tom Tromey's avatar
Tom Tromey committed
887
If THREAD is blocked in `condition-wait', return the condition variable.
888
Otherwise, if THREAD is not blocked, return nil.  */)
889 890 891 892 893 894 895 896 897 898
  (Lisp_Object thread)
{
  struct thread_state *tstate;

  CHECK_THREAD (thread);
  tstate = XTHREAD (thread);

  return tstate->event_object;
}

899 900 901 902 903
static void
thread_join_callback (void *arg)
{
  struct thread_state *tstate = arg;
  struct thread_state *self = current_thread;
904
  Lisp_Object thread;
905

906 907
  XSETTHREAD (thread, tstate);
  self->event_object = thread;
908
  self->wait_condvar = &tstate->thread_condvar;
909
  while (thread_alive_p (tstate) && NILP (self->error_symbol))
910 911 912
    sys_cond_wait (self->wait_condvar, &global_lock);

  self->wait_condvar = NULL;
913
  self->event_object = Qnil;
914 915 916 917
  post_acquire_global_lock (self);
}

DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0,
918 919 920
       doc: /* Wait for THREAD to exit.
This blocks the current thread until THREAD exits or until
the current thread is signaled.
921
It is an error for a thread to try to join itself.  */)
922 923 924 925 926 927 928
  (Lisp_Object thread)
{
  struct thread_state *tstate;

  CHECK_THREAD (thread);
  tstate = XTHREAD (thread);

929
  if (tstate == current_thread)
Eli Zaretskii's avatar
Eli Zaretskii committed
930
    error ("Cannot join current thread");
931

932
  if (thread_alive_p (tstate))
933 934 935 936 937 938
    flush_stack_call_func (thread_join_callback, tstate);

  return Qnil;
}

DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
939
       doc: /* Return a list of all the live threads.  */)
940
  (void)
941 942 943 944 945 946
{
  Lisp_Object result = Qnil;
  struct thread_state *iter;

  for (iter = all_threads; iter; iter = iter->next_thread)
    {
Tom Tromey's avatar
Tom Tromey committed
947 948 949
      if (thread_alive_p (iter))
	{
	  Lisp_Object thread;
950

Tom Tromey's avatar
Tom Tromey committed
951 952 953
	  XSETTHREAD (thread, iter);
	  result = Fcons (thread, result);
	}
954 955 956 957 958
    }

  return result;
}

959 960 961 962 963 964 965
DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 0, 0,
       doc: /* Return the last error form recorded by a dying thread.  */)
  (void)
{
  return last_thread_error;
}

966 967


968
bool
969 970 971 972 973 974 975 976 977 978
thread_check_current_buffer (struct buffer *buffer)
{
  struct thread_state *iter;

  for (iter = all_threads; iter; iter = iter->next_thread)
    {
      if (iter == current_thread)
	continue;

      if (iter->m_current_buffer == buffer)
979
	return true;
980 981
    }

982
  return false;
983 984 985 986
}



987
static void
988
init_main_thread (void)
989
{
990
  main_thread.header.size
991
    = PSEUDOVECSIZE (struct thread_state, m_stack_bottom);
992 993 994 995 996 997 998 999
  XSETPVECTYPE (&main_thread, PVEC_THREAD);
  main_thread.m_last_thing_searched = Qnil;
  main_thread.m_saved_last_thing_searched = Qnil;
  main_thread.name = Qnil;
  main_thread.function = Qnil;
  main_thread.error_symbol = Qnil;
  main_thread.error_data = Qnil;
  main_thread.event_object = Qnil;
1000 1001
}

1002
bool
1003
main_thread_p (void *ptr)
1004
{
1005
  return ptr == &main_thread;
1006 1007
}

1008 1009 1010
void
init_threads_once (void)
{
1011
  init_main_thread ();
1012 1013
}

1014 1015 1016
void
init_threads (void)
{
1017 1018
  init_main_thread ();
  sys_cond_init (&main_thread.thread_condvar);
1019 1020
  sys_mutex_init (&global_lock);
  sys_mutex_lock (&global_lock);
1021 1022
  current_thread = &main_thread;
  main_thread.thread_id = sys_thread_self ();
1023
}
1024 1025 1026 1027

void
syms_of_threads (void)
{
1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049
#ifndef THREADS_ENABLED
  if (0)
#endif
    {
      defsubr (&Sthread_yield);
      defsubr (&Smake_thread);
      defsubr (&Scurrent_thread);
      defsubr (&Sthread_name);
      defsubr (&Sthread_signal);
      defsubr (&Sthread_alive_p);
      defsubr (&Sthread_join);
      defsubr (&Sthread_blocker);
      defsubr (&Sall_threads);
      defsubr (&Smake_mutex);
      defsubr (&Smutex_lock);
      defsubr (&Smutex_unlock);
      defsubr (&Smutex_name);
      defsubr (&Smake_condition_variable);
      defsubr (&Scondition_wait);
      defsubr (&Scondition_notify);
      defsubr (&Scondition_mutex);
      defsubr (&Scondition_name);
1050 1051 1052 1053
      defsubr (&Sthread_last_error);

      staticpro (&last_thread_error);
      last_thread_error = Qnil;
1054
    }
1055

Ken Raeburn's avatar
Ken Raeburn committed
1056 1057 1058
  DEFSYM (Qthreadp, "threadp");
  DEFSYM (Qmutexp, "mutexp");
  DEFSYM (Qcondition_variable_p, "condition-variable-p");
1059
}