thread.c 30 KB
Newer Older
1
/* Threading code.
Paul Eggert's avatar
Paul Eggert committed
2
Copyright (C) 2012-2019 Free Software Foundation, Inc.
3 4 5 6 7 8 9 10 11 12 13 14 15 16

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
17
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
18 19 20 21 22


#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"
Daniel Colascione's avatar
Daniel Colascione committed
28
#include "pdumper.h"
29
#include "keyboard.h"
30

31 32 33 34 35 36 37 38
union aligned_thread_state
{
  struct thread_state s;
  GCALIGNED_UNION_MEMBER
};
verify (GCALIGNED (union aligned_thread_state));

static union aligned_thread_state main_thread;
39

40
struct thread_state *current_thread = &main_thread.s;
41

42
static struct thread_state *all_threads = &main_thread.s;
43

Tom Tromey's avatar
Tom Tromey committed
44
static sys_mutex_t global_lock;
45

Ken Raeburn's avatar
Ken Raeburn committed
46
extern volatile int interrupt_input_blocked;
47 48 49



Tom Tromey's avatar
Tom Tromey committed
50 51
/* m_specpdl is set when the thread is created and cleared when the
   thread dies.  */
52
#define thread_live_p(STATE) ((STATE)->m_specpdl != NULL)
Tom Tromey's avatar
Tom Tromey committed
53 54 55



Tom Tromey's avatar
Tom Tromey committed
56 57 58 59 60 61 62 63 64 65 66
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)
{
67
  struct thread_state *prev_thread = current_thread;
Tom Tromey's avatar
Tom Tromey committed
68

69 70 71 72 73 74
  /* 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
75
    {
76
      /* PREV_THREAD is NULL if the previously current thread
77 78
	 exited.  In this case, there is no reason to unbind, and
	 trying will crash.  */
79 80
      if (prev_thread != NULL)
	unbind_for_thread_switch (prev_thread);
Tom Tromey's avatar
Tom Tromey committed
81 82
      rebind_for_thread_switch ();

83 84 85 86 87
       /* 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
88

89 90 91 92 93 94
   /* 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
95 96 97 98 99 100 101 102 103 104 105 106 107
    {
      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)
{
108
  sys_mutex_lock (&global_lock);
Tom Tromey's avatar
Tom Tromey committed
109 110 111
  post_acquire_global_lock (self);
}

112 113 114 115 116 117
/* This is called from keyboard.c when it detects that SIGINT was
   delivered to the main thread and interrupted thread_select before
   the main 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.  */
118 119 120
void
maybe_reacquire_global_lock (void)
{
121 122 123
  /* SIGINT handler is always run on the main thread, see
     deliver_process_signal, so reflect that in our thread-tracking
     variables.  */
124
  current_thread = &main_thread.s;
125

126 127 128 129 130 131 132 133 134
  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
135 136 137 138 139 140 141 142 143 144


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

145 146
/* Lock MUTEX for thread LOCKER, setting its lock count to COUNT, if
   non-zero, or to 1 otherwise.
147

148 149
   If MUTEX is locked by LOCKER, COUNT must be zero, and the MUTEX's
   lock count will be incremented.
150 151 152 153 154 155 156 157 158

   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
159
static int
160 161
lisp_mutex_lock_for_thread (lisp_mutex_t *mutex, struct thread_state *locker,
			    int new_count)
Tom Tromey's avatar
Tom Tromey committed
162 163 164 165 166
{
  struct thread_state *self;

  if (mutex->owner == NULL)
    {
167
      mutex->owner = locker;
Tom Tromey's avatar
Tom Tromey committed
168 169
      mutex->count = new_count == 0 ? 1 : new_count;
      return 0;
Tom Tromey's avatar
Tom Tromey committed
170
    }
171
  if (mutex->owner == locker)
Tom Tromey's avatar
Tom Tromey committed
172
    {
Tom Tromey's avatar
Tom Tromey committed
173
      eassert (new_count == 0);
Tom Tromey's avatar
Tom Tromey committed
174
      ++mutex->count;
Tom Tromey's avatar
Tom Tromey committed
175
      return 0;
Tom Tromey's avatar
Tom Tromey committed
176 177
    }

178
  self = locker;
Tom Tromey's avatar
Tom Tromey committed
179
  self->wait_condvar = &mutex->condition;
Tom Tromey's avatar
Tom Tromey committed
180
  while (mutex->owner != NULL && (new_count != 0
Tom Tromey's avatar
Tom Tromey committed
181
				  || NILP (self->error_symbol)))
Tom Tromey's avatar
Tom Tromey committed
182 183 184
    sys_cond_wait (&mutex->condition, &global_lock);
  self->wait_condvar = NULL;

Tom Tromey's avatar
Tom Tromey committed
185 186
  if (new_count == 0 && !NILP (self->error_symbol))
    return 1;
Tom Tromey's avatar
Tom Tromey committed
187 188

  mutex->owner = self;
Tom Tromey's avatar
Tom Tromey committed
189 190 191
  mutex->count = new_count == 0 ? 1 : new_count;

  return 1;
Tom Tromey's avatar
Tom Tromey committed
192 193
}

194 195 196 197 198 199
static int
lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
{
  return lisp_mutex_lock_for_thread (mutex, current_thread, new_count);
}

200 201 202 203 204 205
/* 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
206
static int
Tom Tromey's avatar
Tom Tromey committed
207 208 209
lisp_mutex_unlock (lisp_mutex_t *mutex)
{
  if (mutex->owner != current_thread)
Eli Zaretskii's avatar
Eli Zaretskii committed
210
    error ("Cannot unlock mutex owned by another thread");
Tom Tromey's avatar
Tom Tromey committed
211 212

  if (--mutex->count > 0)
Tom Tromey's avatar
Tom Tromey committed
213
    return 0;
Tom Tromey's avatar
Tom Tromey committed
214 215 216 217

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

Tom Tromey's avatar
Tom Tromey committed
218 219 220
  return 1;
}

221 222
/* 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
223 224 225 226 227 228 229 230 231 232 233 234 235
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
236 237 238 239 240 241 242 243
}

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

Tom Tromey's avatar
Tom Tromey committed
244 245 246 247 248 249
static int
lisp_mutex_owned_p (lisp_mutex_t *mutex)
{
  return mutex->owner == current_thread;
}

Tom Tromey's avatar
Tom Tromey committed
250 251


252
DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 1, 0,
253 254 255 256 257 258 259 260 261
       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.  */)
262
  (Lisp_Object name)
263 264 265 266
{
  struct Lisp_Mutex *mutex;
  Lisp_Object result;

267 268 269
  if (!NILP (name))
    CHECK_STRING (name);

270
  mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, name, PVEC_MUTEX);
271 272 273
  memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex),
	  0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex,
						    mutex));
274
  mutex->name = name;
275 276 277 278 279 280 281 282 283 284
  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
285
  struct thread_state *self = current_thread;
286

287 288 289 290
  /* 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
291 292
  if (lisp_mutex_lock (&mutex->mutex, 0))
    post_acquire_global_lock (self);
293 294
}

295 296
static void
do_unwind_mutex_lock (void)
297 298 299 300
{
  current_thread->event_object = Qnil;
}

301
DEFUN ("mutex-lock", Fmutex_lock, Smutex_lock, 1, 1, 0,
302 303 304 305 306
       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
307
is signaled using `thread-signal'.
308 309 310 311
Note that calls to `mutex-lock' and `mutex-unlock' must be paired.  */)
  (Lisp_Object mutex)
{
  struct Lisp_Mutex *lmutex;
312
  ptrdiff_t count = SPECPDL_INDEX ();
313

314 315
  CHECK_MUTEX (mutex);
  lmutex = XMUTEX (mutex);
316

317
  current_thread->event_object = mutex;
318
  record_unwind_protect_void (do_unwind_mutex_lock);
319
  flush_stack_call_func (mutex_lock_callback, lmutex);
320
  return unbind_to (count, Qnil);
321 322 323 324 325 326
}

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

Tom Tromey's avatar
Tom Tromey committed
329
  if (lisp_mutex_unlock (&mutex->mutex))
330
    post_acquire_global_lock (self); /* FIXME: is this call needed? */
331 332 333
}

DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0,
334
       doc: /* Release the mutex.
Ken Raeburn's avatar
Ken Raeburn committed
335
If this thread does not own MUTEX, signal an error.
336 337 338
Otherwise, decrement the mutex's count.  If the count is zero,
release MUTEX.   */)
  (Lisp_Object mutex)
339
{
340
  struct Lisp_Mutex *lmutex;
341

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

345
  flush_stack_call_func (mutex_unlock_callback, lmutex);
346 347 348
  return Qnil;
}

349
DEFUN ("mutex-name", Fmutex_name, Smutex_name, 1, 1, 0,
350 351 352
       doc: /* Return the name of MUTEX.
If no name was given when MUTEX was created, return nil.  */)
  (Lisp_Object mutex)
353
{
354
  struct Lisp_Mutex *lmutex;
355

356 357
  CHECK_MUTEX (mutex);
  lmutex = XMUTEX (mutex);
358

359
  return lmutex->name;
360 361
}

362 363 364 365 366
void
finalize_one_mutex (struct Lisp_Mutex *mutex)
{
  lisp_mutex_destroy (&mutex->mutex);
}
367 368 369



Tom Tromey's avatar
Tom Tromey committed
370 371 372
DEFUN ("make-condition-variable",
       Fmake_condition_variable, Smake_condition_variable,
       1, 2, 0,
373
       doc: /* Make a condition variable associated with MUTEX.
Tom Tromey's avatar
Tom Tromey committed
374 375 376 377 378 379 380 381 382 383 384 385 386 387 388
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);

389
  condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, name, PVEC_CONDVAR);
Tom Tromey's avatar
Tom Tromey committed
390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410
  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
411
  self->event_object = cond;
Tom Tromey's avatar
Tom Tromey committed
412
  saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex);
Paul Eggert's avatar
Paul Eggert committed
413
  /* If signaled while unlocking, skip the wait but reacquire the lock.  */
Tom Tromey's avatar
Tom Tromey committed
414 415 416
  if (NILP (self->error_symbol))
    {
      self->wait_condvar = &cvar->cond;
417
      /* This call could switch to another thread.  */
Tom Tromey's avatar
Tom Tromey committed
418 419 420
      sys_cond_wait (&cvar->cond, &global_lock);
      self->wait_condvar = NULL;
    }
Tom Tromey's avatar
Tom Tromey committed
421
  self->event_object = Qnil;
422 423 424 425 426 427 428 429
  /* 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
430
     post_acquire_global_lock.  */
431
  post_acquire_global_lock (self);
Tom Tromey's avatar
Tom Tromey committed
432 433 434
}

DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0,
435 436
       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
437

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

441
This releases the mutex and waits for COND to be notified or for
Paul Eggert's avatar
Paul Eggert committed
442
this thread to be signaled with `thread-signal'.  When
443 444 445
`condition-wait' returns, COND's mutex will again be locked by
this thread.  */)
  (Lisp_Object cond)
Tom Tromey's avatar
Tom Tromey committed
446 447 448 449
{
  struct Lisp_CondVar *cvar;
  struct Lisp_Mutex *mutex;

450 451
  CHECK_CONDVAR (cond);
  cvar = XCONDVAR (cond);
Tom Tromey's avatar
Tom Tromey committed
452 453 454

  mutex = XMUTEX (cvar->mutex);
  if (!lisp_mutex_owned_p (&mutex->mutex))
Eli Zaretskii's avatar
Eli Zaretskii committed
455
    error ("Condition variable's mutex is not held by current thread");
Tom Tromey's avatar
Tom Tromey committed
456 457 458 459 460 461

  flush_stack_call_func (condition_wait_callback, cvar);

  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
462
/* Used to communicate arguments to condition_notify_callback.  */
Tom Tromey's avatar
Tom Tromey committed
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483
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);
484 485 486 487
  /* 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
488 489 490 491 492
  lisp_mutex_lock (&mutex->mutex, saved_count);
  post_acquire_global_lock (self);
}

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

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

500
This releases COND's mutex when notifying COND.  When
Tom Tromey's avatar
Tom Tromey committed
501 502
`condition-notify' returns, the mutex will again be locked by this
thread.  */)
503
  (Lisp_Object cond, Lisp_Object all)
Tom Tromey's avatar
Tom Tromey committed
504 505 506 507 508
{
  struct Lisp_CondVar *cvar;
  struct Lisp_Mutex *mutex;
  struct notify_args args;

509 510
  CHECK_CONDVAR (cond);
  cvar = XCONDVAR (cond);
Tom Tromey's avatar
Tom Tromey committed
511 512 513

  mutex = XMUTEX (cvar->mutex);
  if (!lisp_mutex_owned_p (&mutex->mutex))
Eli Zaretskii's avatar
Eli Zaretskii committed
514
    error ("Condition variable's mutex is not held by current thread");
Tom Tromey's avatar
Tom Tromey committed
515 516 517 518 519 520 521 522

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

  return Qnil;
}

523
DEFUN ("condition-mutex", Fcondition_mutex, Scondition_mutex, 1, 1, 0,
524 525
       doc: /* Return the mutex associated with condition variable COND.  */)
  (Lisp_Object cond)
526 527 528
{
  struct Lisp_CondVar *cvar;

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

  return cvar->mutex;
}

DEFUN ("condition-name", Fcondition_name, Scondition_name, 1, 1, 0,
536 537 538
       doc: /* Return the name of condition variable COND.
If no name was given when COND was created, return nil.  */)
  (Lisp_Object cond)
539 540 541
{
  struct Lisp_CondVar *cvar;

542 543
  CHECK_CONDVAR (cond);
  cvar = XCONDVAR (cond);
544 545 546 547

  return cvar->name;
}

Tom Tromey's avatar
Tom Tromey committed
548 549 550 551 552 553 554 555
void
finalize_one_condvar (struct Lisp_CondVar *condvar)
{
  sys_cond_destroy (&condvar->cond);
}



Tom Tromey's avatar
Tom Tromey committed
556 557 558 559
struct select_args
{
  select_func *func;
  int max_fds;
Ken Raeburn's avatar
Ken Raeburn committed
560 561 562 563
  fd_set *rfds;
  fd_set *wfds;
  fd_set *efds;
  struct timespec *timeout;
Tom Tromey's avatar
Tom Tromey committed
564 565 566 567 568 569 570 571 572
  sigset_t *sigmask;
  int result;
};

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

575 576
  block_interrupt_signal (&oldset);
  self->not_holding_lock = 1;
Tom Tromey's avatar
Tom Tromey committed
577
  release_global_lock ();
578 579
  restore_signal_mask (&oldset);

Tom Tromey's avatar
Tom Tromey committed
580 581
  sa->result = (sa->func) (sa->max_fds, sa->rfds, sa->wfds, sa->efds,
			   sa->timeout, sa->sigmask);
582 583

  block_interrupt_signal (&oldset);
584 585 586 587 588 589 590 591 592
  /* If we were interrupted by C-g while inside sa->func above, the
     signal handler could have called maybe_reacquire_global_lock, in
     which case we are already holding the lock and shouldn't try
     taking it again, or else we will hang forever.  */
  if (self->not_holding_lock)
    {
      acquire_global_lock (self);
      self->not_holding_lock = 0;
    }
593
  restore_signal_mask (&oldset);
Tom Tromey's avatar
Tom Tromey committed
594 595 596
}

int
Ken Raeburn's avatar
Ken Raeburn committed
597 598
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
599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615
	       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;
}



616 617 618
static void
mark_one_thread (struct thread_state *thread)
{
619
  /* Get the stack top now, in case mark_specpdl changes it.  */
620
  void const *stack_top = thread->stack_top;
621

622
  mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr);
623

624
  mark_stack (thread->m_stack_bottom, stack_top);
625

626 627
  for (struct handler *handler = thread->m_handlerlist;
       handler; handler = handler->next)
628
    {
Ken Raeburn's avatar
Ken Raeburn committed
629 630
      mark_object (handler->tag_or_ch);
      mark_object (handler->val);
631 632 633 634
    }

  if (thread->m_current_buffer)
    {
635
      Lisp_Object tem;
636 637 638 639 640 641
      XSETBUFFER (tem, thread->m_current_buffer);
      mark_object (tem);
    }

  mark_object (thread->m_last_thing_searched);

642
  if (!NILP (thread->m_saved_last_thing_searched))
643 644 645 646 647 648 649 650 651
    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)
652 653 654 655 656 657 658
    {
      Lisp_Object thread_obj;

      XSETTHREAD (thread_obj, iter);
      mark_object (thread_obj);
      mark_one_thread (iter);
    }
659 660 661 662 663 664 665 666
}

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

667 668 669
void
unmark_main_thread (void)
{
670
  main_thread.s.header.size &= ~ARRAY_MARK_FLAG;
671 672
}

673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695


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)
{
696
  ptrdiff_t count = SPECPDL_INDEX ();
697

698
  current_thread->result = Ffuncall (1, &current_thread->function);
699 700 701
  return unbind_to (count, Qnil);
}

702 703
static Lisp_Object last_thread_error;

704
static Lisp_Object
705
record_thread_error (Lisp_Object error_form)
706
{
707 708
  last_thread_error = error_form;
  return error_form;
709 710 711 712 713
}

static void *
run_thread (void *state)
{
714 715
  /* Make sure stack_top and m_stack_bottom are properly aligned as GC
     expects.  */
716
  max_align_t stack_pos;
717

718 719 720
  struct thread_state *self = state;
  struct thread_state **iter;

721
  self->m_stack_bottom = self->stack_top = (char *) &stack_pos;
722 723 724 725
  self->thread_id = sys_thread_self ();

  acquire_global_lock (self);

726 727 728 729 730 731 732 733 734
  /* 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
735

736
  /* It might be nice to do something with errors here.  */
737
  internal_condition_case (invoke_thread_function, Qt, record_thread_error);
738

Tom Tromey's avatar
Tom Tromey committed
739 740
  update_processes_for_thread_death (Fcurrent_thread ());

Tom Tromey's avatar
Tom Tromey committed
741
  xfree (self->m_specpdl - 1);
742 743 744 745
  self->m_specpdl = NULL;
  self->m_specpdl_ptr = NULL;
  self->m_specpdl_size = 0;

Ken Raeburn's avatar
Ken Raeburn committed
746 747 748 749 750 751 752 753 754
  {
    struct handler *c, *c_next;
    for (c = handlerlist_sentinel; c; c = c_next)
      {
	c_next = c->nextfree;
	xfree (c);
      }
  }

755
  current_thread = NULL;
756 757
  sys_cond_broadcast (&self->thread_condvar);

Tom Tromey's avatar
Tom Tromey committed
758 759 760 761 762 763 764 765
  /* 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;

766 767 768 769 770
  release_global_lock ();

  return NULL;
}

771 772 773 774 775 776 777 778 779 780
static void
free_search_regs (struct re_registers *regs)
{
  if (regs->num_regs != 0)
    {
      xfree (regs->start);
      xfree (regs->end);
    }
}

781
void
782
finalize_one_thread (struct thread_state *state)
783
{
784 785
  free_search_regs (&state->m_search_regs);
  free_search_regs (&state->m_saved_search_regs);
786 787 788 789 790 791
  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.
792
If NAME is given, it must be a string; it names the new thread.  */)
793 794 795 796 797
  (Lisp_Object function, Lisp_Object name)
{
  sys_thread_t thr;
  struct thread_state *new_thread;
  Lisp_Object result;
798
  const char *c_name = NULL;
799
  size_t offset = offsetof (struct thread_state, m_stack_bottom);
800 801 802

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

805 806 807
  if (!NILP (name))
    CHECK_STRING (name);

808
  new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, event_object,
809
				      PVEC_THREAD);
Ken Raeburn's avatar
Ken Raeburn committed
810 811
  memset ((char *) new_thread + offset, 0,
	  sizeof (struct thread_state) - offset);
812 813 814 815 816 817

  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;
818
  new_thread->result = Qnil;
819 820
  new_thread->error_symbol = Qnil;
  new_thread->error_data = Qnil;
821
  new_thread->event_object = Qnil;
822 823

  new_thread->m_specpdl_size = 50;
Tom Tromey's avatar
Tom Tromey committed
824 825 826 827
  new_thread->m_specpdl = xmalloc ((1 + new_thread->m_specpdl_size)
				   * sizeof (union specbinding));
  /* Skip the dummy entry.  */
  ++new_thread->m_specpdl;
828 829 830 831 832 833 834 835
  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;

836 837 838 839
  if (!NILP (name))
    c_name = SSDATA (ENCODE_UTF_8 (name));

  if (! sys_thread_create (&thr, c_name, run_thread, new_thread))
840 841 842
    {
      /* Restore the previous situation.  */
      all_threads = all_threads->next_thread;
Eli Zaretskii's avatar
Eli Zaretskii committed
843
#ifdef THREADS_ENABLED
844
      error ("Could not start a new thread");
Eli Zaretskii's avatar
Eli Zaretskii committed
845 846 847
#else
      error ("Concurrency is not supported in this configuration");
#endif
848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887
    }

  /* 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,
888 889 890
       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
891
This will interrupt a blocked call to `mutex-lock', `condition-wait',
892 893
or `thread-join' in the target thread.
If THREAD is the main thread, just the error message is shown.  */)
894 895 896 897 898 899 900 901 902 903
  (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);

904
#ifdef THREADS_ENABLED
905 906 907 908 909 910 911 912 913 914 915 916 917 918
  if (main_thread_p (tstate))
    {
      /* Construct an event.  */
      struct input_event event;
      EVENT_INIT (event);
      event.kind = THREAD_EVENT;
      event.frame_or_window = Qnil;
      event.arg = list3 (Fcurrent_thread (), error_symbol, data);

      /* Store it into the input event queue.  */
      kbd_buffer_store_event (&event);
    }

  else
919
#endif
920 921 922 923 924
    {
      /* What to do if thread is already signaled?  */
      /* What if error_symbol is Qnil?  */
      tstate->error_symbol = error_symbol;
      tstate->error_data = data;
925

926 927 928
      if (tstate->wait_condvar)
	flush_stack_call_func (thread_signal_callback, tstate);
    }
929 930 931 932

  return Qnil;
}

933
DEFUN ("thread-live-p", Fthread_live_p, Sthread_live_p, 1, 1, 0,
934
       doc: /* Return t if THREAD is alive, or nil if it has exited.  */)
935 936 937 938 939 940 941
  (Lisp_Object thread)
{
  struct thread_state *tstate;

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

942
  return thread_live_p (tstate) ? Qt : Qnil;
943 944
}

945
DEFUN ("thread--blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0,
946 947 948 949
       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
950
If THREAD is blocked in `condition-wait', return the condition variable.
951
Otherwise, if THREAD is not blocked, return nil.  */)
952 953 954 955 956 957 958 959 960 961
  (Lisp_Object thread)
{
  struct thread_state *tstate;

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

  return tstate->event_object;
}

962 963 964 965 966
static void
thread_join_callback (void *arg)
{
  struct thread_state *tstate = arg;
  struct thread_state *self = current_thread;
967
  Lisp_Object thread;
968

969 970
  XSETTHREAD (thread, tstate);
  self->event_object = thread;
971
  self->wait_condvar = &tstate->thread_condvar;
972
  while (thread_live_p (tstate) && NILP (self->error_symbol))
973 974 975
    sys_cond_wait (self->wait_condvar, &global_lock);

  self->wait_condvar = NULL;
976
  self->event_object = Qnil;
977 978 979 980
  post_acquire_global_lock (self);
}

DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0,
981
       doc: /* Wait for THREAD to exit.
982 983 984
This blocks the current thread until THREAD exits or until the current
thread is signaled.  It returns the result of the THREAD function.  It
is an error for a thread to try to join itself.  */)
985 986 987
  (Lisp_Object thread)
{
  struct thread_state *tstate;
988
  Lisp_Object error_symbol, error_data;
989 990 991 992

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

993
  if (tstate == current_thread)
Eli Zaretskii's avatar
Eli Zaretskii committed
994
    error ("Cannot join current thread");
995

996 997 998
  error_symbol = tstate->error_symbol;
  error_data = tstate->error_data;

999
  if (thread_live_p (tstate))
1000 1001
    flush_stack_call_func (thread_join_callback, tstate);

1002 1003 1004 1005
  if (!NILP (error_symbol))
    Fsignal (error_symbol, error_data);

  return tstate->result;
1006 1007 1008
}

DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
1009
       doc: /* Return a list of all the live threads.  */)
1010
  (void)
1011 1012 1013 1014 1015 1016
{
  Lisp_Object result = Qnil;
  struct thread_state *iter;

  for (iter = all_threads; iter; iter = iter->next_thread)
    {
1017
      if (thread_live_p (iter))
Tom Tromey's avatar
Tom Tromey committed
1018 1019
	{
	  Lisp_Object thread;
1020

Tom Tromey's avatar
Tom Tromey committed
1021 1022 1023
	  XSETTHREAD (thread, iter);
	  result = Fcons (thread, result);
	}
1024 1025 1026 1027 1028
    }

  return result;
}

1029 1030 1031 1032
DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 1, 0,
       doc: /* Return the last error form recorded by a dying thread.
If CLEANUP is non-nil, remove this error form from history.  */)
     (Lisp_Object cleanup)
1033
{
1034 1035 1036 1037 1038 1039
  Lisp_Object result = last_thread_error;

  if (!NILP (cleanup))
    last_thread_error = Qnil;

  return result;
1040 1041
}

1042 1043


1044
bool
1045 1046 1047 1048 1049 1050 1051 1052 1053 1054
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)
1055
	return true;
1056 1057
    }

1058
  return false;
1059 1060 1061 1062
}



1063
static void
1064
init_main_thread (void)
1065
{
1066
  main_thread.s.header.size
1067
    = PSEUDOVECSIZE (struct thread_state, event_object);
1068 1069 1070 1071 1072 1073 1074 1075 1076
  XSETPVECTYPE (&main_thread.s, PVEC_THREAD);
  main_thread.s.m_last_thing_searched = Qnil;
  main_thread.s.m_saved_last_thing_searched = Qnil;
  main_thread.s.name = Qnil;
  main_thread.s.function = Qnil;
  main_thread.s.result = Qnil;
  main_thread.s.error_symbol = Qnil;
  main_thread.s.error_data = Qnil;
  main_thread.s.event_object = Qnil;
1077 1078
}

1079
bool
Daniel Colascione's avatar
Daniel Colascione committed
1080
main_thread_p (const void *ptr)
1081
{
1082
  return ptr == &main_thread.s;
1083 1084
}

1085 1086 1087 1088 1089 1090 1091 1092
bool
in_current_thread (void)
{
  if (current_thread == NULL)
    return false;
  return sys_thread_equal (sys_thread_self (), current_thread->thread_id);
}

1093 1094 1095
void
init_threads_once (void)
{
1096
  init_main_thread ();
1097 1098
}

1099 1100 1101
void
init_threads (void)
{
1102
  init_main_thread ();
1103
  sys_cond_init (&main_thread.s.thread_condvar);
1104 1105
  sys_mutex_init (&global_lock);
  sys_mutex_lock (&global_lock);
1106 1107
  current_thread = &main_thread.s;
  main_thread.s.thread_id = sys_thread_self ();
1108
}
1109 1110 1111 1112

void
syms_of_threads (void)
{
1113 1114 1115 1116 1117 1118 1119 1120 1121
#ifndef THREADS_ENABLED
  if (0)
#endif
    {
      defsubr (&Sthread_yield);
      defsubr (&Smake_thread);
      defsubr (&Scurrent_thread);
      defsubr (&Sthread_name);
      defsubr (&Sthread_signal);
1122
      defsubr (&Sthread_live_p);
1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134
      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);
1135 1136 1137 1138
      defsubr (&Sthread_last_error);

      staticpro (&last_thread_error);
      last_thread_error = Qnil;
Michael Albinus's avatar
Michael Albinus committed
1139

1140 1141 1142
      Fdefalias (intern_c_string ("thread-alive-p"),
		 intern_c_string ("thread-live-p"), Qnil);

Michael Albinus's avatar
Michael Albinus committed
1143
      Fprovide (intern_c_string ("threads"), Qnil);
1144
    }
1145

Ken Raeburn's avatar
Ken Raeburn committed
1146 1147 1148
  DEFSYM (Qthreadp, "threadp");
  DEFSYM (Qmutexp, "mutexp");
  DEFSYM (Qcondition_variable_p, "condition-variable-p");
1149

1150
  DEFVAR_LISP ("main-thread", Vmain_thread,
1151 1152
    doc: /* The main thread of Emacs.  */);
#ifdef THREADS_ENABLED
1153
  XSETTHREAD (Vmain_thread, &main_thread.s);
1154 1155 1156
#else
  Vmain_thread = Qnil;
#endif
1157
}