/[guile]/guile/guile-core/libguile/coop-pthreads.c
ViewVC logotype

Diff of /guile/guile-core/libguile/coop-pthreads.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by mvo, Wed Oct 30 10:41:51 2002 UTC revision 1.3 by mvo, Wed Oct 30 20:28:52 2002 UTC
# Line 60  Line 60 
60     XXX - more overview here.     XXX - more overview here.
61  */  */
62    
63  /* All data is protected by a single mutex: guile_mutex. */  /* All data (except the ready queue) is protected by a single mutex:
64       guile_mutex. */
65    
66  static pthread_mutex_t guile_mutex = PTHREAD_MUTEX_INITIALIZER;  static pthread_mutex_t guile_mutex = PTHREAD_MUTEX_INITIALIZER;
67    
# Line 105  init_thread_creator (SCM thread, pthread Line 106  init_thread_creator (SCM thread, pthread
106    scm_copt_thread *t = SCM_THREAD_DATA(thread);    scm_copt_thread *t = SCM_THREAD_DATA(thread);
107    t->root = r;    t->root = r;
108    t->pthread = th;    t->pthread = th;
109      t->base = NULL;
110    pthread_cond_init (&t->sleep_cond, NULL);    pthread_cond_init (&t->sleep_cond, NULL);
111    #if 0
112      fprintf (stderr, "%ld created %ld\n", pthread_self (), th);
113    #endif
114  }  }
115    
116  static void  static void
# Line 120  static SCM Line 125  static SCM
125  thread_mark (SCM obj)  thread_mark (SCM obj)
126  {  {
127    scm_copt_thread *t = SCM_THREAD_DATA (obj);    scm_copt_thread *t = SCM_THREAD_DATA (obj);
128    #if 0
129      fprintf (stderr, "marking %ld\n", t->pthread);
130    #endif
131    scm_gc_mark (t->result);    scm_gc_mark (t->result);
132    return t->root->handle;    return t->root->handle;
133  }  }
# Line 145  static size_t Line 153  static size_t
153  thread_free (SCM obj)  thread_free (SCM obj)
154  {  {
155    scm_copt_thread *t = SCM_THREAD_DATA (obj);    scm_copt_thread *t = SCM_THREAD_DATA (obj);
156    #if 0
157      fprintf (stderr, "freeing %ld\n", t->pthread);
158    #endif
159    if (t->pthread != -1)    if (t->pthread != -1)
160      abort ();      abort ();
161    scm_gc_free (t, sizeof (*t), "thread");    scm_gc_free (t, sizeof (*t), "thread");
# Line 185  dequeue (SCM q) Line 196  dequeue (SCM q)
196      }      }
197  }  }
198    
199  /*** Ready queue */  /*** Scheduling */
200    
201    /* When a thread wants to execute Guile functions, it locks the
202       guile_mutex.  Since that is not necessarily fair, we put a layer on
203       top so that only one or a few threads actually compete for that
204       mutex.
205    
206       There is a global ready_queue with threads that want the
207       guile_mutex.  When a thread gives up its mutex, it dequeues one
208       thread from the ready_queue and signals its condition variable.
209    
210       To enter Guile, a thread first tries to lock the guile_mutex and
211       when that succeeds it has entered.  Otherwise, it puts itself on
212       the ready_queue and waits for its condition variable.
213    */
214    
215  /* Normally, queues are implemented with the procedures above, but the  /* Normally, queues are implemented with the procedures above, but the
216     ready queue is special.  We need to put threads on it from the     ready queue is special.  We need to put threads on it from the
# Line 194  dequeue (SCM q) Line 219  dequeue (SCM q)
219     objects.     objects.
220  */  */
221    
222    static SCM cur_thread;
223    
224  static pthread_mutex_t ready_queue_mutex = PTHREAD_MUTEX_INITIALIZER;  static pthread_mutex_t ready_queue_mutex = PTHREAD_MUTEX_INITIALIZER;
225  static scm_copt_thread *next_ready = NULL;  static scm_copt_thread *next_ready = NULL;
226  static scm_copt_thread *last_ready = NULL;  static scm_copt_thread *last_ready = NULL;
227    
228  static void  static void
229  get_ready (scm_copt_thread *t)  dump_ready_queue (void)
230    {
231    #if 0
232      scm_copt_thread *t;
233      fprintf (stderr, "ready queue:");
234      for (t = next_ready; t; t = t->next_ready)
235        {
236          fprintf (stderr, " %ld", t->pthread);
237          if (t == last_ready)
238            fprintf (stderr, ".");
239        }
240      fprintf (stderr, "\n");
241    #endif
242    }
243    
244    static void
245    put_on_ready_queue_locked (scm_copt_thread *t)
246  {  {
247    pthread_mutex_lock (&ready_queue_mutex);    pthread_mutex_lock (&ready_queue_mutex);
248    t->next_ready = NULL;    t->next_ready = NULL;
# Line 208  get_ready (scm_copt_thread *t) Line 251  get_ready (scm_copt_thread *t)
251    else    else
252      next_ready = t;      next_ready = t;
253    last_ready = t;    last_ready = t;
   pthread_mutex_unlock (&ready_queue_mutex);  
254  }  }
255    
256  static scm_copt_thread *  static void
257  get_next_ready ()  put_on_ready_queue (scm_copt_thread *t)
258  {  {
259    scm_copt_thread *t;    put_on_ready_queue_locked (t);
   pthread_mutex_lock (&ready_queue_mutex);  
   t = next_ready;  
   if (t)  
     {  
       next_ready = t->next_ready;  
       if (next_ready == NULL)  
         last_ready = NULL;  
     }  
   return t;  
260    pthread_mutex_unlock (&ready_queue_mutex);    pthread_mutex_unlock (&ready_queue_mutex);
261  }  }
262    
 /*** Running and sleeping */  
   
 static SCM cur_thread;  
   
 /* Kick the next runnable thread if there is one.  
  */  
263  static void  static void
264  kick_next ()  enter_guile (scm_copt_thread *t)
265  {  {
266    scm_copt_thread *next = get_next_ready (ready_queue);    if (pthread_mutex_trylock (&guile_mutex) == EBUSY)
267    if (next)      {
268      pthread_cond_signal (&next->sleep_cond);        put_on_ready_queue_locked (t);
269    #if 0
270          fprintf (stderr, "%ld entering\n", pthread_self ());
271    #endif
272          dump_ready_queue ();
273          pthread_cond_wait (&t->sleep_cond, &ready_queue_mutex);
274          pthread_mutex_unlock (&ready_queue_mutex);
275          pthread_mutex_lock (&guile_mutex);
276        }
277    #if 0
278      fprintf (stderr, "%ld is in\n", pthread_self ());
279    #endif
280      cur_thread = t->handle;
281      t->top = NULL;
282  }  }
283      
284  static SCM  static scm_copt_thread *
285  suspend ()  leave_guile ()
286  {  {
287    SCM cur = cur_thread;    SCM cur = cur_thread;
288    scm_copt_thread *c = SCM_THREAD_DATA (cur);    scm_copt_thread *c = SCM_THREAD_DATA (cur);
# Line 253  suspend () Line 293  suspend ()
293    SCM_FLUSH_REGISTER_WINDOWS;    SCM_FLUSH_REGISTER_WINDOWS;
294    setjmp (c->regs);    setjmp (c->regs);
295    
296    return cur;  #if 0
297  }    fprintf (stderr, "%ld leaving\n", pthread_self ());
298    #endif
299    
300      if (next_ready)
301        {
302          /* next_ready will never become NULL expect here.  Thus, we
303             don't need to test again after getting the mutex.
304          */
305          scm_copt_thread *n = next_ready;
306          pthread_mutex_lock (&ready_queue_mutex);
307          dump_ready_queue ();
308          next_ready = n->next_ready;
309          if (next_ready == NULL)
310            last_ready = NULL;
311          pthread_mutex_unlock (&ready_queue_mutex);
312    #if 0
313          fprintf (stderr, "%ld kicking %ld\n", pthread_self (), n->pthread);
314    #endif
315          pthread_cond_signal (&n->sleep_cond);
316        }
317    
 static void  
 release ()  
 {  
318    pthread_mutex_unlock (&guile_mutex);    pthread_mutex_unlock (&guile_mutex);
 }  
319    
320  static void    return c;
 acquire ()  
 {  
   please = 1;  
   pthread_mutex_lock (&guile_mutex);  
321  }  }
322    
323  static void  static void
324  resume (SCM cur)  block ()
325  {  {
326      SCM cur = cur_thread;
327    scm_copt_thread *c = SCM_THREAD_DATA (cur);    scm_copt_thread *c = SCM_THREAD_DATA (cur);
328    
329      /* record top of stack for the GC */
330      c->top = (SCM_STACKITEM *)&c;
331      /* save registers. */
332      SCM_FLUSH_REGISTER_WINDOWS;
333      setjmp (c->regs);
334    
335    #if 0
336      fprintf (stderr, "%ld blocking\n", pthread_self ());
337    #endif
338    
339      if (next_ready)
340        {
341          /* next_ready will never become NULL expect here.  Thus, we
342             don't need to test again after getting the mutex.
343          */
344          scm_copt_thread *n = next_ready;
345          pthread_mutex_lock (&ready_queue_mutex);
346          dump_ready_queue ();
347          next_ready = n->next_ready;
348          if (next_ready == NULL)
349            last_ready = NULL;
350          pthread_mutex_unlock (&ready_queue_mutex);
351    #if 0
352          fprintf (stderr, "%ld kicking %ld\n", pthread_self (), n->pthread);
353    #endif
354          pthread_cond_signal (&n->sleep_cond);
355        }
356    
357      pthread_cond_wait (&c->sleep_cond, &guile_mutex);
358    
359    #if 0
360      fprintf (stderr, "%ld is back\n", pthread_self ());
361    #endif
362    cur_thread = cur;    cur_thread = cur;
363    c->top = NULL;    c->top = NULL;
364  }  }
365    
366  static void  int scm_switch_counter;
 block ()  
 {  
   SCM cur = suspend ();  
   scm_copt_thread *c = SCM_THREAD_DATA (cur);  
   pthread_cond_wait (&c->sleep_cond, &guile_mutex);  
   resume (cur);  
 }  
367    
 /* Yielding consists of getting the next thread from the ready_queue  
    and if there is one, putting ourselves on the ready queue and  
    block.  
 */  
368  SCM  SCM
369  scm_yield ()  scm_yield ()
370  {  {
371    scm_copt_thread *next = get_next_ready ();    if (next_ready)
   if (next)  
372      {      {
373        pthread_cond_signal (&next->sleep_cond);        put_on_ready_queue (SCM_THREAD_DATA (cur_thread));
       get_ready (SCM_THREAD_DATA (cur_thread));  
374        block ();        block ();
375      }      }
376    return SCM_BOOL_T;    return SCM_BOOL_T;
377  }  }
378    
 int scm_switch_counter;  
379    
380  /*** Thread creation */  /*** Thread creation */
381    
# Line 336  really_launch (SCM_STACKITEM *base, SCM Line 408  really_launch (SCM_STACKITEM *base, SCM
408  {  {
409    scm_copt_thread *t = SCM_THREAD_DATA (thread);    scm_copt_thread *t = SCM_THREAD_DATA (thread);
410    scheme_launch_data data;    scheme_launch_data data;
411      enter_guile (t);
412    init_thread_creatant (thread, base);    init_thread_creatant (thread, base);
   resume (thread);  
413    
414    /* Ok, we bullied our way in, now be nice and stand in queue.  #if 0
415     */    fprintf (stderr, "%ld is ready\n", pthread_self ());
416    scm_yield ();  #endif
417    
418    data.rootcont = SCM_BOOL_F;    data.rootcont = SCM_BOOL_F;
419    data.body = SCM_CAR (t->result);    data.body = SCM_CAR (t->result);
# Line 353  really_launch (SCM_STACKITEM *base, SCM Line 425  really_launch (SCM_STACKITEM *base, SCM
425                         &data, base);                         &data, base);
426    pthread_detach (t->pthread);    pthread_detach (t->pthread);
427    
   {  
     SCM next = dequeue (ready_queue);  
     if (!SCM_FALSEP (next))  
       {  
         scm_copt_thread *n = SCM_THREAD_DATA (next);  
         pthread_cond_signal (&n->sleep_cond);  
       }  
   }  
   
428    all_threads = scm_delq (thread, all_threads);    all_threads = scm_delq (thread, all_threads);
429    t->pthread = -1;    t->pthread = -1;
430    thread_count--;    thread_count--;
431    suspend ();    leave_guile ();
432  }  }
433    
434  static void *  static void *
435  scheme_launch_thread (void *p)  scheme_launch_thread (void *p)
436  {  {
   acquire ();  
437    really_launch ((SCM_STACKITEM *)&p, (SCM)p);    really_launch ((SCM_STACKITEM *)&p, (SCM)p);
   release ();  
438    return NULL;    return NULL;
439  }  }
440    
# Line 495  scm_lock_mutex (SCM mx) Line 556  scm_lock_mutex (SCM mx)
556        while (m->owner != cur_thread)        while (m->owner != cur_thread)
557          {          {
558            enqueue (m->waiting, cur_thread);            enqueue (m->waiting, cur_thread);
           kick_next ();  
559            block ();            block ();
560            SCM_ASYNC_TICK;            SCM_ASYNC_TICK;
561          }          }
# Line 527  scm_unlock_mutex (SCM mx) Line 587  scm_unlock_mutex (SCM mx)
587        if (!SCM_FALSEP (next))        if (!SCM_FALSEP (next))
588          {          {
589            m->owner = next;            m->owner = next;
590            enqueue (ready_queue, next);            put_on_ready_queue (SCM_THREAD_DATA (next));
591            scm_yield ();            scm_yield ();
592          }          }
593        else        else
# Line 548  scm_threads_init (SCM_STACKITEM *base) Line 608  scm_threads_init (SCM_STACKITEM *base)
608    
609    scm_switch_counter = SCM_THREAD_SWITCH_COUNT;    scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
610    
   acquire ();  
611    cur_thread = make_thread (SCM_BOOL_F);    cur_thread = make_thread (SCM_BOOL_F);
612      enter_guile (SCM_THREAD_DATA (cur_thread));
613    /* root is set later from init.c */    /* root is set later from init.c */
614    init_thread_creator (cur_thread, pthread_self(), NULL);    init_thread_creator (cur_thread, pthread_self(), NULL);
615    init_thread_creatant (cur_thread, base);    init_thread_creatant (cur_thread, base);
616    resume (cur_thread);  
617    thread_count = 1;    thread_count = 1;
618    scm_gc_register_root (&all_threads);    scm_gc_register_root (&all_threads);
619    all_threads = scm_cons (cur_thread, SCM_EOL);    all_threads = scm_cons (cur_thread, SCM_EOL);
# Line 563  scm_threads_init (SCM_STACKITEM *base) Line 623  scm_threads_init (SCM_STACKITEM *base)
623    scm_set_smob_free (scm_tc16_thread, thread_free);    scm_set_smob_free (scm_tc16_thread, thread_free);
624    
625    scm_set_smob_mark (scm_tc16_mutex, mutex_mark);    scm_set_smob_mark (scm_tc16_mutex, mutex_mark);
   
   ready_queue = scm_permanent_object (make_queue ());  
626  }  }
627    
628  /*** Marking stacks */  /*** Marking stacks */
# Line 677  scm_internal_select (int nfds, Line 735  scm_internal_select (int nfds,
735                       struct timeval *timeout)                       struct timeval *timeout)
736  {  {
737    int res;    int res;
738    SCM cur = suspend ();    scm_copt_thread *c = leave_guile ();
   release ();  
739    res = select (nfds, readfds, writefds, exceptfds, timeout);    res = select (nfds, readfds, writefds, exceptfds, timeout);
740    acquire ();    enter_guile (c);
   resume (cur);  
741    SCM_ASYNC_TICK;    SCM_ASYNC_TICK;
742    return res;    return res;
743  }  }
# Line 899  scm_signal_condition_variable (SCM c) Line 955  scm_signal_condition_variable (SCM c)
955  unsigned long  unsigned long
956  scm_thread_usleep (unsigned long usec)  scm_thread_usleep (unsigned long usec)
957  {  {
958    return usleep (usec);    usleep (usec);
959      return 0;
960  }  }
961    
962  unsigned long  unsigned long

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26