libguile/coop.c

   1 /*      Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41 \f
  42
  43 /* $Id: coop.c,v 1.28 2001-10-06 16:30:20 mdj Exp $ */
  44
  45 /* Cooperative thread library, based on QuickThreads */
  46
  47 #include <stdio.h>
  48
  49 #ifdef HAVE_UNISTD_H
  50 #include <unistd.h>
  51 #endif
  52
  53 #include <errno.h>
  54
  55 #include "qt/qt.h"
  56 #include "libguile/eval.h"
  57
  58 \f/* #define COOP_STKSIZE (0x10000) */
  59 #define COOP_STKSIZE (scm_eval_stack)
  60
  61 /* `alignment' must be a power of 2. */
  62 #define COOP_STKALIGN(sp, alignment) \
  63 ((void *)((((qt_word_t)(sp)) + (alignment) - 1) & ~((alignment)-1)))
  64
  65 \f
  66
  67 /* Queue access functions. */
  68
  69 static void
  70 coop_qinit (coop_q_t *q)
  71 {
  72   q->t.next = q->tail = &q->t;
  73
  74   q->t.all_prev = NULL;
  75   q->t.all_next = NULL;
  76 #ifdef GUILE_ISELECT
  77   q->t.nfds = 0;
  78   q->t.readfds = NULL;
  79   q->t.writefds = NULL;
  80   q->t.exceptfds = NULL;
  81   q->t.timeoutp = 0;
  82 #endif
  83 }
  84
  85
  86 coop_t *
  87 coop_qget (coop_q_t *q)
  88 {
  89   coop_t *t;
  90
  91   t = q->t.next;
  92   q->t.next = t->next;
  93   if (t->next == &q->t)
  94     {
  95       if (t == &q->t)
  96         {                       /* If it was already empty .. */
  97           return NULL;          /* .. say so. */
  98         }
  99       q->tail = &q->t;          /* Else now it is empty. */
 100     }
 101   return (t);
 102 }
 103
 104
 105 void
 106 coop_qput (coop_q_t *q, coop_t *t)
 107 {
 108   q->tail->next = t;
 109   t->next = &q->t;
 110   q->tail = t;
 111 }
 112
 113 static void
 114 coop_all_qput (coop_q_t *q, coop_t *t)
 115 {
 116   if (q->t.all_next)
 117     q->t.all_next->all_prev = t;
 118   t->all_prev = NULL;
 119   t->all_next = q->t.all_next;
 120   q->t.all_next = t;
 121 }
 122
 123 static void
 124 coop_all_qremove (coop_q_t *q, coop_t *t)
 125 {
 126   if (t->all_prev)
 127     t->all_prev->all_next = t->all_next;
 128   else
 129     q->t.all_next = t->all_next;
 130   if (t->all_next)
 131       t->all_next->all_prev = t->all_prev;
 132 }
 133
 134 #ifdef GUILE_ISELECT
 135 /* Insert thread t into the ordered queue q.
 136    q is ordered after wakeup_time.  Threads which aren't sleeping but
 137    waiting for I/O go last into the queue. */
 138 void
 139 coop_timeout_qinsert (coop_q_t *q, coop_t *t)
 140 {
 141   coop_t *pred = &q->t;
 142   int sec = t->wakeup_time.tv_sec;
 143   int usec = t->wakeup_time.tv_usec;
 144   while (pred->next != &q->t
 145          && pred->next->timeoutp
 146          && (pred->next->wakeup_time.tv_sec < sec
 147              || (pred->next->wakeup_time.tv_sec == sec
 148                  && pred->next->wakeup_time.tv_usec < usec)))
 149     pred = pred->next;
 150   t->next = pred->next;
 151   pred->next = t;
 152   if (t->next == &q->t)
 153     q->tail = t;
 154 }
 155 #endif
 156
 157
 158 \f/* Thread routines. */
 159
 160 coop_q_t coop_global_runq;      /* A queue of runable threads. */
 161 coop_q_t coop_global_sleepq;    /* A queue of sleeping threads. */
 162 coop_q_t coop_tmp_queue;        /* A temp working queue */
 163 coop_q_t coop_global_allq;      /* A queue of all threads. */
 164 static coop_t coop_global_main; /* Thread for the process. */
 165 coop_t *coop_global_curr;       /* Currently-executing thread. */
 166
 167 #ifdef GUILE_PTHREAD_COMPAT
 168 static coop_q_t coop_deadq;
 169 static int coop_quitting_p = -1;
 170 static pthread_cond_t coop_cond_quit;
 171 static pthread_cond_t coop_cond_create;
 172 static pthread_mutex_t coop_mutex_create;
 173 static pthread_t coop_mother;
 174 static int mother_awake_p = 0;
 175 static coop_t *coop_child;
 176 #endif
 177
 178 static void *coop_starthelp (qt_t *old, void *ignore0, void *ignore1);
 179 static void coop_only (void *pu, void *pt, qt_userf_t *f);
 180 static void *coop_aborthelp (qt_t *sp, void *old, void *null);
 181 static void *coop_yieldhelp (qt_t *sp, void *old, void *blockq);
 182
 183
 184 /* called on process termination.  */
 185 #ifdef HAVE_ATEXIT
 186 static void
 187 coop_finish (void)
 188 #else
 189 #ifdef HAVE_ON_EXIT
 190 extern int on_exit (void (*procp) (), int arg);
 191
 192 static void
 193 coop_finish (int status, void *arg)
 194 #else
 195 #error Dont know how to setup a cleanup handler on your system.
 196 #endif
 197 #endif
 198 {
 199 #ifdef GUILE_PTHREAD_COMPAT
 200   coop_quitting_p = 1;
 201   pthread_cond_signal (&coop_cond_create);
 202   pthread_cond_broadcast (&coop_cond_quit);
 203 #endif
 204 }
 205
 206 void
 207 coop_init ()
 208 {
 209   coop_qinit (&coop_global_runq);
 210   coop_qinit (&coop_global_sleepq);
 211   coop_qinit (&coop_tmp_queue);
 212   coop_qinit (&coop_global_allq);
 213   coop_global_curr = &coop_global_main;
 214 #ifdef GUILE_PTHREAD_COMPAT
 215   coop_qinit (&coop_deadq);
 216   pthread_cond_init (&coop_cond_quit, NULL);
 217   pthread_cond_init (&coop_cond_create, NULL);
 218   pthread_mutex_init (&coop_mutex_create, NULL);
 219 #endif
 220 #ifdef HAVE_ATEXIT
 221   atexit (coop_finish);
 222 #else
 223 #ifdef HAVE_ON_EXIT
 224   on_exit (coop_finish, 0);
 225 #endif
 226 #endif
 227 }
 228
 229 /* Return the next runnable thread. If no threads are currently runnable,
 230    and there are sleeping threads - wait until one wakes up. Otherwise,
 231    return NULL. */
 232
 233 #ifndef GUILE_ISELECT
 234 coop_t *
 235 coop_next_runnable_thread()
 236 {
 237   int sleepers;
 238   coop_t *t;
 239   time_t now;
 240
 241   do {
 242     sleepers = 0;
 243     now = time(NULL);
 244
 245     /* Check the sleeping queue */
 246     while ((t = coop_qget(&coop_global_sleepq)) != NULL)
 247       {
 248         sleepers++;
 249         if (t->wakeup_time <= now)
 250           coop_qput(&coop_global_runq, t);
 251         else
 252           coop_qput(&coop_tmp_queue, t);
 253       }
 254     while ((t = coop_qget(&coop_tmp_queue)) != NULL)
 255       coop_qput(&coop_global_sleepq, t);
 256
 257     t = coop_qget (&coop_global_runq);
 258
 259   } while ((t == NULL) && (sleepers > 0));
 260
 261   return t;
 262 }
 263 #endif
 264
 265 void
 266 coop_start()
 267 {
 268   coop_t *next;
 269
 270   while ((next = coop_qget (&coop_global_runq)) != NULL) {
 271     coop_global_curr = next;
 272     QT_BLOCK (coop_starthelp, 0, 0, next->sp);
 273   }
 274 }
 275
 276
 277 static void *
 278 coop_starthelp (qt_t *old, void *ignore0, void *ignore1)
 279 {
 280   coop_global_main.sp = old;
 281   coop_global_main.joining = NULL;
 282   coop_qput (&coop_global_runq, &coop_global_main);
 283   return NULL; /* not used, but keeps compiler happy */
 284 }
 285
 286 int
 287 coop_mutex_init (coop_m *m)
 288 {
 289   return coop_new_mutex_init (m, NULL);
 290 }
 291
 292 int
 293 coop_new_mutex_init (coop_m *m, coop_mattr *attr)
 294 {
 295   m->owner = NULL;
 296   coop_qinit(&(m->waiting));
 297   return 0;
 298 }
 299
 300 int
 301 coop_mutex_trylock (coop_m *m)
 302 {
 303   if (m->owner == NULL)
 304     {
 305       m->owner = coop_global_curr;
 306       return 0;
 307     }
 308   else
 309     return EBUSY;
 310 }
 311
 312 int
 313 coop_mutex_lock (coop_m *m)
 314 {
 315   if (m->owner == NULL)
 316     {
 317       m->owner = coop_global_curr;
 318     }
 319   else
 320     {
 321       coop_t *old, *newthread;
 322
 323       /* Record the current top-of-stack before going to sleep */
 324       coop_global_curr->top = &old;
 325
 326 #ifdef GUILE_ISELECT
 327       newthread = coop_wait_for_runnable_thread();
 328       if (newthread == coop_global_curr)
 329         coop_abort ();
 330 #else
 331       newthread = coop_next_runnable_thread();
 332 #endif
 333       old = coop_global_curr;
 334       coop_global_curr = newthread;
 335       QT_BLOCK (coop_yieldhelp, old, &(m->waiting), newthread->sp);
 336     }
 337   return 0;
 338 }
 339
 340
 341 int
 342 coop_mutex_unlock (coop_m *m)
 343 {
 344   coop_t *old, *newthread;
 345
 346   newthread = coop_qget (&(m->waiting));
 347   if (newthread != NULL)
 348     {
 349       /* Record the current top-of-stack before going to sleep */
 350       coop_global_curr->top = &old;
 351
 352       old = coop_global_curr;
 353       coop_global_curr = newthread;
 354       /* The new thread came into m->waiting through a lock operation.
 355          It now owns this mutex. */
 356       m->owner = coop_global_curr;
 357       QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
 358     }
 359   else
 360     {
 361       m->owner = NULL;
 362     }
 363   return 0;
 364 }
 365
 366
 367 int
 368 coop_mutex_destroy (coop_m *m)
 369 {
 370   return 0;
 371 }
 372
 373
 374 int
 375 coop_condition_variable_init (coop_c *c)
 376 {
 377   return coop_new_condition_variable_init (c, NULL);
 378 }
 379
 380 int
 381 coop_new_condition_variable_init (coop_c *c, coop_cattr *a)
 382 {
 383   coop_qinit(&(c->waiting));
 384   return 0;
 385 }
 386
 387 int
 388 coop_condition_variable_wait_mutex (coop_c *c, coop_m *m)
 389 {
 390   coop_t *old, *newthread;
 391
 392   /* coop_mutex_unlock (m); */
 393   newthread = coop_qget (&(m->waiting));
 394   if (newthread != NULL)
 395     {
 396       m->owner = newthread;
 397     }
 398   else
 399     {
 400       m->owner = NULL;
 401       /*fixme* Should we really wait here?  Isn't it OK just to proceed? */
 402 #ifdef GUILE_ISELECT
 403       newthread = coop_wait_for_runnable_thread();
 404       if (newthread == coop_global_curr)
 405         coop_abort ();
 406 #else
 407       newthread = coop_next_runnable_thread();
 408 #endif
 409     }
 410   coop_global_curr->top = &old;
 411   old = coop_global_curr;
 412   coop_global_curr = newthread;
 413   QT_BLOCK (coop_yieldhelp, old, &(c->waiting), newthread->sp);
 414
 415   coop_mutex_lock (m);
 416   return 0;
 417 }
 418
 419 int
 420 coop_condition_variable_timed_wait_mutex (coop_c *c,
 421                                           coop_m *m,
 422                                           const struct timespec *abstime)
 423 {
 424   coop_t *old, *t;
 425   int res = ETIMEDOUT;
 426
 427   /* coop_mutex_unlock (m); */
 428   t = coop_qget (&(m->waiting));
 429   if (t != NULL)
 430     {
 431       m->owner = t;
 432     }
 433   else
 434     {
 435       m->owner = NULL;
 436 #ifdef GUILE_ISELECT
 437       coop_global_curr->timeoutp = 1;
 438       coop_global_curr->wakeup_time.tv_sec = abstime->tv_sec;
 439       coop_global_curr->wakeup_time.tv_usec = abstime->tv_nsec / 1000;
 440       coop_timeout_qinsert (&coop_global_sleepq, coop_global_curr);
 441       t = coop_wait_for_runnable_thread();
 442 #else
 443       /*fixme* Implement!*/
 444       t = coop_next_runnable_thread();
 445 #endif
 446     }
 447   if (t != coop_global_curr)
 448     {
 449       coop_global_curr->top = &old;
 450       old = coop_global_curr;
 451       coop_global_curr = t;
 452       QT_BLOCK (coop_yieldhelp, old, &(c->waiting), t->sp);
 453
 454       /* Are we still in the sleep queue? */
 455       old = &coop_global_sleepq.t;
 456       for (t = old->next; t != &coop_global_sleepq.t; old = t, t = t->next)
 457         if (t == coop_global_curr)
 458           {
 459             old->next = t->next; /* unlink */
 460             res = 0;
 461             break;
 462           }
 463     }
 464   coop_mutex_lock (m);
 465   return res;
 466 }
 467
 468 int
 469 coop_condition_variable_signal (coop_c *c)
 470 {
 471   coop_t *newthread;
 472
 473   while ((newthread = coop_qget (&(c->waiting))) != NULL)
 474     {
 475       coop_qput (&coop_global_runq, newthread);
 476     }
 477   return 0;
 478 }
 479
 480 /* {Keys}
 481  */
 482
 483 static int n_keys = 0;
 484 static int max_keys = 0;
 485 static void (**destructors) (void *) = 0;
 486
 487 int
 488 coop_key_create (coop_k *keyp, void (*destructor) (void *value))
 489 {
 490   if (n_keys >= max_keys)
 491     {
 492       int i;
 493       max_keys = max_keys ? max_keys * 3 / 2 : 10;
 494       destructors = realloc (destructors, sizeof (void *) * max_keys);
 495       if (destructors == 0)
 496         {
 497           fprintf (stderr, "Virtual memory exceeded in coop_key_create\n");
 498           exit (1);
 499         }
 500       for (i = n_keys; i < max_keys; ++i)
 501         destructors[i] = NULL;
 502     }
 503   destructors[n_keys] = destructor;
 504   *keyp = n_keys++;
 505   return 0;
 506 }
 507
 508 int
 509 coop_setspecific (coop_k key, const void *value)
 510 {
 511   int n_keys = coop_global_curr->n_keys;
 512   if (key >= n_keys)
 513     {
 514       int i;
 515       coop_global_curr->n_keys = max_keys;
 516       coop_global_curr->specific = realloc (n_keys
 517                                             ? coop_global_curr->specific
 518                                             : NULL,
 519                                             sizeof (void *) * max_keys);
 520       if (coop_global_curr->specific == 0)
 521         {
 522           fprintf (stderr, "Virtual memory exceeded in coop_setspecific\n");
 523           exit (1);
 524         }
 525       for (i = n_keys; i < max_keys; ++i)
 526         coop_global_curr->specific[i] = NULL;
 527     }
 528   coop_global_curr->specific[key] = (void *) value;
 529   return 0;
 530 }
 531
 532 void *
 533 coop_getspecific (coop_k key)
 534 {
 535   return (key < coop_global_curr->n_keys
 536           ? coop_global_curr->specific[key]
 537           : NULL);
 538 }
 539
 540 int
 541 coop_key_delete (coop_k key)
 542 {
 543   return 0;
 544 }
 545
 546
 547 int
 548 coop_condition_variable_destroy (coop_c *c)
 549 {
 550   return 0;
 551 }
 552
 553 #ifdef GUILE_PTHREAD_COMPAT
 554
 555 /* 1K room for the cond wait routine */
 556 #ifdef SCM_STACK_GROWS_UP
 557 #define COOP_STACK_ROOM (256)
 558 #else
 559 #define COOP_STACK_ROOM (-256)
 560 #endif
 561
 562 static void *
 563 dummy_start (void *coop_thread)
 564 {
 565   coop_t *t = (coop_t *) coop_thread;
 566   int res;
 567   t->sp = (qt_t *) (&t + COOP_STACK_ROOM);
 568   pthread_mutex_init (&t->dummy_mutex, NULL);
 569   pthread_mutex_lock (&t->dummy_mutex);
 570   coop_child = 0;
 571   do
 572     res = pthread_cond_wait (&coop_cond_quit, &t->dummy_mutex);
 573   while (res == EINTR);
 574   return 0;
 575 }
 576
 577 static void *
 578 mother (void *dummy)
 579 {
 580   pthread_mutex_lock (&coop_mutex_create);
 581   while (!coop_quitting_p)
 582     {
 583       int res;
 584       pthread_create (&coop_child->dummy_thread,
 585                       NULL,
 586                       dummy_start,
 587                       coop_child);
 588       mother_awake_p = 0;
 589       do
 590         res = pthread_cond_wait (&coop_cond_create, &coop_mutex_create);
 591       while (res == EINTR);
 592     }
 593   return 0;
 594 }
 595
 596 #endif
 597
 598 coop_t *
 599 coop_create (coop_userf_t *f, void *pu)
 600 {
 601   coop_t *t;
 602 #ifndef GUILE_PTHREAD_COMPAT
 603   void *sto;
 604 #endif
 605
 606 #ifdef GUILE_PTHREAD_COMPAT
 607   t = coop_qget (&coop_deadq);
 608   if (t)
 609     {
 610       t->sp = t->base;
 611       t->specific = 0;
 612       t->n_keys = 0;
 613     }
 614   else
 615 #endif
 616     {
 617       t = malloc (sizeof (coop_t));
 618
 619       t->specific = NULL;
 620       t->n_keys = 0;
 621 #ifdef GUILE_PTHREAD_COMPAT
 622       coop_child = t;
 623       mother_awake_p = 1;
 624       if (coop_quitting_p < 0)
 625         {
 626           coop_quitting_p = 0;
 627           /* We can't create threads ourselves since the pthread
 628            * corresponding to this stack might be sleeping.
 629            */
 630           pthread_create (&coop_mother, NULL, mother, NULL);
 631         }
 632       else
 633         {
 634           pthread_cond_signal (&coop_cond_create);
 635         }
 636       /* We can't use a pthreads condition variable since "this"
 637        * pthread could already be asleep.  We can't use a COOP
 638        * condition variable because they are not safe against
 639        * pre-emptive switching.
 640        */
 641       while (coop_child || mother_awake_p)
 642         usleep (0);
 643 #else
 644       t->sto = malloc (COOP_STKSIZE);
 645       sto = COOP_STKALIGN (t->sto, QT_STKALIGN);
 646       t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN);
 647 #endif
 648       t->base = t->sp;
 649     }
 650   t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, coop_only);
 651   t->joining = NULL;
 652   coop_qput (&coop_global_runq, t);
 653   coop_all_qput (&coop_global_allq, t);
 654
 655   return t;
 656 }
 657
 658
 659 static void
 660 coop_only (void *pu, void *pt, qt_userf_t *f)
 661 {
 662   coop_global_curr = (coop_t *)pt;
 663   (*(coop_userf_t *)f)(pu);
 664   coop_abort();
 665   /* NOTREACHED */
 666 }
 667
 668
 669 void
 670 coop_abort ()
 671 {
 672   coop_t *old, *newthread;
 673
 674   /* Wake up any threads that are waiting to join this one */
 675   if (coop_global_curr->joining)
 676     {
 677       while ((newthread = coop_qget ((coop_q_t *)(coop_global_curr->joining)))
 678              != NULL)
 679         {
 680           coop_qput (&coop_global_runq, newthread);
 681         }
 682       free (coop_global_curr->joining);
 683     }
 684
 685 #ifdef GUILE_ISELECT
 686   scm_I_am_dead = 1;
 687   do {
 688     newthread = coop_wait_for_runnable_thread();
 689   } while (newthread == coop_global_curr);
 690   scm_I_am_dead = 0;
 691 #else
 692   newthread = coop_next_runnable_thread();
 693 #endif
 694   coop_all_qremove (&coop_global_allq, coop_global_curr);
 695   old = coop_global_curr;
 696   coop_global_curr = newthread;
 697   QT_ABORT (coop_aborthelp, old, (void *) NULL, newthread->sp);
 698 }
 699
 700
 701 static void *
 702 coop_aborthelp (qt_t *sp, void *old, void *null)
 703 {
 704   coop_t *oldthread = (coop_t *) old;
 705
 706   if (oldthread->specific)
 707     free (oldthread->specific);
 708 #ifndef GUILE_PTHREAD_COMPAT
 709   free (oldthread->sto);
 710   free (oldthread);
 711 #else
 712   coop_qput (&coop_deadq, oldthread);
 713 #endif
 714
 715   return NULL;
 716 }
 717
 718
 719 void
 720 coop_join(coop_t *t)
 721 {
 722   coop_t *old, *newthread;
 723
 724   /* Create a join list if necessary */
 725   if (t->joining == NULL)
 726     {
 727       t->joining = malloc(sizeof(coop_q_t));
 728       coop_qinit((coop_q_t *) t->joining);
 729     }
 730
 731 #ifdef GUILE_ISELECT
 732   newthread = coop_wait_for_runnable_thread();
 733   if (newthread == coop_global_curr)
 734     return;
 735 #else
 736   newthread = coop_next_runnable_thread();
 737 #endif
 738   old = coop_global_curr;
 739   coop_global_curr = newthread;
 740   QT_BLOCK (coop_yieldhelp, old, (coop_q_t *) t->joining, newthread->sp);
 741 }
 742
 743 void
 744 coop_yield()
 745 {
 746   coop_t *old = NULL;
 747   coop_t *newthread;
 748
 749   newthread = coop_next_runnable_thread();
 750
 751   /* There may be no other runnable threads. Return if this is the
 752      case. */
 753 #if GUILE_ISELECT
 754   if (newthread == coop_global_curr)
 755       return;
 756 #else
 757   if (newthread == NULL)
 758       return;
 759 #endif
 760
 761   old = coop_global_curr;
 762
 763   coop_global_curr = newthread;
 764   QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
 765 }
 766
 767
 768 static void *
 769 coop_yieldhelp (qt_t *sp, void *old, void *blockq)
 770 {
 771   ((coop_t *)old)->sp = sp;
 772   coop_qput ((coop_q_t *)blockq, (coop_t *)old);
 773   return NULL;
 774 }
 775
 776 /* Replacement for the system's sleep() function. Does the right thing
 777    for the process - but not for the system (it busy-waits) */
 778
 779 void *
 780 coop_sleephelp (qt_t *sp, void *old, void *blockq)
 781 {
 782   ((coop_t *)old)->sp = sp;
 783   /* old is already on the sleep queue - so there's no need to
 784      do anything extra here */
 785   return NULL;
 786 }
 787
 788 #ifdef GUILE_ISELECT
 789
 790 unsigned long
 791 scm_thread_usleep (unsigned long usec)
 792 {
 793   struct timeval timeout;
 794   timeout.tv_sec = 0;
 795   timeout.tv_usec = usec;
 796   scm_internal_select (0, NULL, NULL, NULL, &timeout);
 797   return 0;  /* Maybe we should calculate actual time slept,
 798                 but this is faster... :) */
 799 }
 800
 801 unsigned long
 802 scm_thread_sleep (unsigned long sec)
 803 {
 804   time_t now = time (NULL);
 805   struct timeval timeout;
 806   unsigned long slept;
 807   timeout.tv_sec = sec;
 808   timeout.tv_usec = 0;
 809   scm_internal_select (0, NULL, NULL, NULL, &timeout);
 810   slept = time (NULL) - now;
 811   return slept > sec ? 0 : sec - slept;
 812 }
 813
 814 #else /* GUILE_ISELECT */
 815
 816 unsigned long
 817 scm_thread_sleep (unsigned long s)
 818 {
 819   coop_t *newthread, *old;
 820   time_t now = time (NULL);
 821   coop_global_curr->wakeup_time = now + s;
 822
 823   /* Put the current thread on the sleep queue */
 824   coop_qput (&coop_global_sleepq, coop_global_curr);
 825
 826   newthread = coop_next_runnable_thread();
 827
 828   /* If newthread is the same as the sleeping thread, do nothing */
 829   if (newthread == coop_global_curr)
 830     return s;
 831
 832   old = coop_global_curr;
 833
 834   coop_global_curr = newthread;
 835   QT_BLOCK (coop_sleephelp, old, NULL, newthread->sp);
 836
 837   return s;
 838 }
 839
 840 unsigned long
 841 scm_thread_usleep (unsigned long usec)
 842 {
 843   /* We're so cheap.  */
 844   scm_thread_sleep (usec / 1000000);
 845   struct timeval timeout;
 846   return 0;  /* Maybe we should calculate actual time slept,
 847                 but this is faster... :) */
 848 }
 849
 850 #endif /* GUILE_ISELECT */
 851
 852 /*
 853   Local Variables:
 854   c-file-style: "gnu"
 855   End:
 856 */