src/thread.c

   1
   2 #include <config.h>
   3 #include "lisp.h"
   4 #include "buffer.h"
   5 #include "blockinput.h"
   6 #include <pthread.h>
   7 #include "systime.h"
   8 #include "sysselect.h"
   9
  10 void mark_byte_stack P_ ((struct byte_stack *));
  11 void mark_backtrace P_ ((struct backtrace *));
  12 void mark_catchlist P_ ((struct catchtag *));
  13 void mark_stack P_ ((char *, char *));
  14 void flush_stack_call_func P_ ((void (*) (char *, void *), void *));
  15
  16 /* Get the next thread as in circular buffer.  */
  17 #define NEXT_THREAD(x)(x->next_thread ? x->next_thread : all_threads)
  18
  19 /* condition var .. w/ global lock */
  20
  21 static pthread_cond_t thread_cond;
  22
  23 static struct thread_state primary_thread;
  24
  25 static struct thread_state *all_threads = &primary_thread;
  26
  27 __thread struct thread_state *current_thread = &primary_thread;
  28
  29 static int inhibit_yield_counter = 0;
  30
  31 pthread_mutex_t global_lock;
  32
  33 /* Used internally by the scheduler, it is the next that will be executed.  */
  34 static pthread_t next_thread;
  35
  36 /* Choose the next thread to be executed.  */
  37 static void
  38 thread_schedule ()
  39 {
  40   struct thread_state *it = current_thread;
  41   do
  42     {
  43       it = NEXT_THREAD (it);
  44     }
  45   while (it->blocked && it != current_thread);
  46
  47   next_thread = it->pthread_id;
  48 }
  49
  50 /* Schedule a new thread and block the caller until it is not scheduled
  51    again.  */
  52 static inline void
  53 reschedule (char *end, int wait)
  54 {
  55   current_thread->stack_top = end;
  56   if (!thread_inhibit_yield_p ())
  57     thread_schedule ();
  58
  59   if (next_thread != current_thread->pthread_id)
  60     pthread_cond_broadcast (&thread_cond);
  61
  62   if (!wait)
  63     return;
  64
  65   pthread_mutex_unlock (&global_lock);
  66
  67   pthread_mutex_lock (&global_lock);
  68
  69   while (current_thread->pthread_id != next_thread)
  70     pthread_cond_wait (&thread_cond, &global_lock);
  71 }
  72
  73 static void
  74 mark_one_thread (struct thread_state *thread)
  75 {
  76   register struct specbinding *bind;
  77   struct handler *handler;
  78   Lisp_Object tem;
  79
  80   for (bind = thread->m_specpdl; bind != thread->m_specpdl_ptr; bind++)
  81     {
  82       mark_object (bind->symbol);
  83       mark_object (bind->old_value);
  84     }
  85
  86 #if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
  87      || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
  88   mark_stack (thread->stack_bottom, thread->stack_top);
  89 #else
  90   {
  91     register struct gcpro *tail;
  92     for (tail = thread->m_gcprolist; tail; tail = tail->next)
  93       for (i = 0; i < tail->nvars; i++)
  94         mark_object (tail->var[i]);
  95   }
  96 #endif
  97
  98   if (thread->m_byte_stack_list)
  99     mark_byte_stack (thread->m_byte_stack_list);
 100
 101   mark_catchlist (thread->m_catchlist);
 102
 103   for (handler = thread->m_handlerlist; handler; handler = handler->next)
 104     {
 105       mark_object (handler->handler);
 106       mark_object (handler->var);
 107     }
 108
 109   mark_backtrace (thread->m_backtrace_list);
 110
 111   if (thread->m_current_buffer)
 112     {
 113       XSETBUFFER (tem, thread->m_current_buffer);
 114       mark_object (tem);
 115     }
 116
 117   mark_object (thread->m_last_thing_searched);
 118
 119   if (thread->m_saved_last_thing_searched)
 120     mark_object (thread->m_saved_last_thing_searched);
 121 }
 122
 123 static void
 124 mark_threads_callback (char *end, void *ignore)
 125 {
 126   struct thread_state *iter;
 127
 128   current_thread->stack_top = end;
 129   for (iter = all_threads; iter; iter = iter->next_thread)
 130     {
 131       Lisp_Object thread_obj;
 132       XSETTHREAD (thread_obj, iter);
 133       mark_object (thread_obj);
 134       mark_one_thread (iter);
 135     }
 136 }
 137
 138 void
 139 mark_threads (void)
 140 {
 141   flush_stack_call_func (mark_threads_callback, NULL);
 142 }
 143
 144 void
 145 unmark_threads (void)
 146 {
 147   struct thread_state *iter;
 148
 149   for (iter = all_threads; iter; iter = iter->next_thread)
 150     if (iter->m_byte_stack_list)
 151       unmark_byte_stack (iter->m_byte_stack_list);
 152 }
 153
 154 int
 155 thread_inhibit_yield_p  ()
 156 {
 157   return inhibit_yield_counter || interrupt_input_blocked || abort_on_gc;
 158 }
 159
 160 static void
 161 thread_yield_callback (char *end, void *ignore)
 162 {
 163   if (!thread_inhibit_yield_p ())
 164     reschedule (end, 1);
 165 }
 166
 167 void
 168 thread_yield (void)
 169 {
 170   /* Note: currently it is safe to check this here, but eventually it
 171      will require a lock to ensure non-racy operation.  */
 172   /* Only yield if there is another thread to yield to.  */
 173   if (all_threads->next_thread)
 174     flush_stack_call_func (thread_yield_callback, NULL);
 175 }
 176
 177 DEFUN ("yield", Fyield, Syield, 0, 0, 0,
 178        doc: /* Yield to the next thread.  */)
 179      (void)
 180 {
 181   thread_yield ();
 182   return other_threads_p () ? Qt : Qnil;
 183 }
 184
 185 static Lisp_Object
 186 invoke_thread_function (void)
 187 {
 188   Lisp_Object iter;
 189
 190   int count = SPECPDL_INDEX ();
 191
 192   /* Set up specpdl.  */
 193   for (iter = current_thread->initial_specpdl;
 194        !EQ (iter, Qnil);
 195        iter = XCDR (iter))
 196     {
 197       /* We may bind a variable twice -- but it doesn't matter because
 198          there is no way to undo these bindings without exiting the
 199          thread.  */
 200       specbind (XCAR (XCAR (iter)), XCDR (XCAR (iter)));
 201     }
 202   current_thread->initial_specpdl = Qnil;
 203
 204   Feval (current_thread->func);
 205   return unbind_to (count, Qnil);
 206 }
 207
 208 static Lisp_Object
 209 do_nothing (Lisp_Object whatever)
 210 {
 211   return whatever;
 212 }
 213
 214 static void *
 215 run_thread (void *state)
 216 {
 217   struct thread_state *self = state;
 218   struct thread_state **iter;
 219   struct gcpro gcpro1;
 220   Lisp_Object buffer;
 221   char stack_pos;
 222
 223   self->stack_top = self->stack_bottom = &stack_pos;
 224
 225   self->m_specpdl_size = 50;
 226   self->m_specpdl = xmalloc (self->m_specpdl_size
 227                              * sizeof (struct specbinding));
 228   self->m_specpdl_ptr = self->m_specpdl;
 229   self->pthread_id = pthread_self ();
 230
 231   /* Thread-local assignment.  */
 232   current_thread = self;
 233
 234   /* We need special handling to set the initial buffer.  Our parent
 235      thread is very likely to be using this same buffer so we will
 236      typically wait for the parent thread to release it first.  */
 237   XSETBUFFER (buffer, self->m_current_buffer);
 238   GCPRO1 (buffer);
 239   self->m_current_buffer = 0;
 240
 241   pthread_mutex_lock (&global_lock);
 242
 243   set_buffer_internal (XBUFFER (buffer));
 244
 245   /* It might be nice to do something with errors here.  */
 246   internal_condition_case (invoke_thread_function, Qt, do_nothing);
 247
 248   blocal_unbind_thread (get_current_thread ());
 249
 250   /* Unlink this thread from the list of all threads.  */
 251   for (iter = &all_threads; *iter != self; iter = &(*iter)->next_thread)
 252     ;
 253   *iter = (*iter)->next_thread;
 254
 255   thread_schedule ();
 256   pthread_cond_broadcast (&thread_cond);
 257
 258   xfree (self->m_specpdl);
 259
 260   pthread_mutex_unlock (&global_lock);
 261
 262   return NULL;
 263 }
 264
 265 DEFUN ("run-in-thread", Frun_in_thread, Srun_in_thread, 1, 1, 0,
 266        doc: /* Start a new thread and run FUNCTION in it.
 267 When the function exits, the thread dies.  */)
 268      (function)
 269      Lisp_Object function;
 270 {
 271   char stack_pos;
 272   pthread_t thr;
 273   struct thread_state *new_thread;
 274   struct specbinding *p;
 275
 276   /* Can't start a thread in temacs.  */
 277   if (!initialized)
 278     abort ();
 279
 280   new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_gcprolist,
 281                                       PVEC_THREAD);
 282   memset ((char *) new_thread + OFFSETOF (struct thread_state, m_gcprolist),
 283           0, sizeof (struct thread_state) - OFFSETOF (struct thread_state,
 284                                                       m_gcprolist));
 285
 286   new_thread->func = function;
 287   new_thread->blocked = 0;
 288   new_thread->initial_specpdl = Qnil;
 289   new_thread->m_last_thing_searched = Qnil; /* copy from parent? */
 290   new_thread->m_saved_last_thing_searched = Qnil;
 291   new_thread->m_current_buffer = current_thread->m_current_buffer;
 292   new_thread->stack_bottom = &stack_pos;
 293
 294   for (p = specpdl; p != specpdl_ptr; ++p)
 295     {
 296       if (!p->func)
 297         {
 298           Lisp_Object sym = p->symbol;
 299           if (!SYMBOLP (sym))
 300             sym = XCAR (sym);
 301           new_thread->initial_specpdl
 302             = Fcons (Fcons (sym, find_symbol_value (sym)),
 303                      new_thread->initial_specpdl);
 304         }
 305     }
 306
 307   /* We'll need locking here.  */
 308   new_thread->next_thread = all_threads;
 309   all_threads = new_thread;
 310
 311   if (pthread_create (&thr, NULL, run_thread, new_thread))
 312     {
 313       /* Restore the previous situation.  */
 314       all_threads = all_threads->next_thread;
 315       error ("Could not start a new thread");
 316     }
 317
 318   return Qnil;
 319 }
 320
 321 /* Get the current thread as a lisp object.  */
 322 Lisp_Object
 323 get_current_thread (void)
 324 {
 325   Lisp_Object result;
 326   XSETTHREAD (result, current_thread);
 327   return result;
 328 }
 329
 330 /* Get the main thread as a lisp object.  */
 331 Lisp_Object
 332 get_main_thread (void)
 333 {
 334   Lisp_Object result;
 335   XSETTHREAD (result, &primary_thread);
 336   return result;
 337 }
 338
 339 /* Is the current an user thread.  */
 340 int
 341 user_thread_p (void)
 342 {
 343   struct thread_state *it = all_threads;
 344   pthread_t self = pthread_self ();
 345   do
 346     {
 347       if (it->pthread_id == self)
 348         return 1;
 349     }
 350   while (it = it->next_thread);
 351
 352   return 0;
 353 }
 354
 355 DEFUN ("inhibit-yield", Finhibit_yield, Sinhibit_yield, 1, 1, 0,
 356        doc: /* Inhibit the yield function.  */)
 357      (val)
 358      Lisp_Object val;
 359 {
 360   if (!EQ (val, Qnil))
 361     inhibit_yield_counter++;
 362   else if (inhibit_yield_counter > 0)
 363     inhibit_yield_counter--;
 364
 365   return Qnil;
 366 }
 367
 368 int
 369 thread_select (n, rfd, wfd, xfd, tmo)
 370   int n;
 371   SELECT_TYPE *rfd, *wfd, *xfd;
 372   EMACS_TIME *tmo;
 373 {
 374   char end;
 375   int ret;
 376   current_thread->blocked = 1;
 377
 378   reschedule (&end, 0);
 379
 380   pthread_mutex_unlock (&global_lock);
 381
 382   ret = select (n, rfd, wfd, xfd, tmo);
 383   current_thread->blocked = 0;
 384
 385   pthread_mutex_lock (&global_lock);
 386   pthread_cond_broadcast (&thread_cond);
 387
 388   while (current_thread->pthread_id != next_thread)
 389     pthread_cond_wait (&thread_cond, &global_lock);
 390
 391   return ret;
 392 }
 393
 394 int
 395 other_threads_p (void)
 396 {
 397   return all_threads->next ? 1 : 0;
 398 }
 399
 400 Lisp_Object
 401 thread_notify_kill_buffer (register struct buffer *b)
 402 {
 403   register Lisp_Object tem;
 404   struct thread_state *it = all_threads;
 405   for (; it; it = it->next_thread)
 406     {
 407       if (b == it->m_current_buffer)
 408         {
 409           register Lisp_Object buf;
 410           XSETBUFFER (buf, it->m_current_buffer);
 411           tem = Fother_buffer (buf, Qnil, Qnil);
 412           it->m_current_buffer = XBUFFER (tem);
 413           if (b == it->m_current_buffer)
 414             return Qnil;
 415         }
 416     }
 417
 418   return Qt;
 419 }
 420
 421 void
 422 init_threads_once (void)
 423 {
 424   primary_thread.size = PSEUDOVECSIZE (struct thread_state, m_gcprolist);
 425   primary_thread.next = NULL;
 426   primary_thread.func = Qnil;
 427   primary_thread.initial_specpdl = Qnil;
 428   XSETPVECTYPE (&primary_thread, PVEC_THREAD);
 429 }
 430
 431 void
 432 init_threads (void)
 433 {
 434   pthread_mutex_init (&global_lock, NULL);
 435   pthread_cond_init (&thread_cond, NULL);
 436   pthread_mutex_lock (&global_lock);
 437
 438   primary_thread.pthread_id = pthread_self ();
 439   primary_thread.blocked = 0;
 440   primary_thread.m_last_thing_searched = Qnil;
 441   next_thread = primary_thread.pthread_id;
 442 }
 443
 444 void
 445 syms_of_threads (void)
 446 {
 447   defsubr (&Srun_in_thread);
 448   defsubr (&Syield);
 449   defsubr (&Sinhibit_yield);
 450 }