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