libguile/coop.c

   1 /*      Copyright (C) 1995, 1996, 1997, 1998 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.15 1998-11-19 08:15:22 mdj Exp $ */
  44
  45 /* Cooperative thread library, based on QuickThreads */
  46
  47 #ifdef HAVE_UNISTD_H
  48 #include <unistd.h>
  49 #endif
  50
  51 #include <qt.h>
  52 #include "eval.h"
  53
  54 \f/* #define COOP_STKSIZE (0x10000) */
  55 #define COOP_STKSIZE (scm_eval_stack)
  56
  57 /* `alignment' must be a power of 2. */
  58 #define COOP_STKALIGN(sp, alignment) \
  59 ((void *)((((qt_word_t)(sp)) + (alignment) - 1) & ~((alignment)-1)))
  60
  61 \f
  62
  63 /* Queue access functions. */
  64
  65 #ifdef __STDC__
  66 static void
  67 coop_qinit (coop_q_t *q)
  68 #else
  69 static void
  70 coop_qinit (q)
  71      coop_q_t *q;
  72 #endif
  73 {
  74   q->t.next = q->tail = &q->t;
  75
  76   q->t.all_prev = NULL;
  77   q->t.all_next = NULL;
  78 #ifdef GUILE_ISELECT
  79   q->t.nfds = 0;
  80   q->t.readfds = NULL;
  81   q->t.writefds = NULL;
  82   q->t.exceptfds = NULL;
  83   q->t.timeoutp = 0;
  84 #endif
  85 }
  86
  87
  88 #ifdef __STDC__
  89 coop_t *
  90 coop_qget (coop_q_t *q)
  91 #else
  92 coop_t *
  93 coop_qget (q)
  94      coop_q_t *q;
  95 #endif
  96 {
  97   coop_t *t;
  98
  99   t = q->t.next;
 100   q->t.next = t->next;
 101   if (t->next == &q->t) {
 102     if (t == &q->t) {           /* If it was already empty .. */
 103       return (NULL);            /* .. say so. */
 104     }
 105     q->tail = &q->t;            /* Else now it is empty. */
 106   }
 107   return (t);
 108 }
 109
 110
 111 #ifdef __STDC__
 112 void
 113 coop_qput (coop_q_t *q, coop_t *t)
 114 #else
 115 void
 116 coop_qput (q, t)
 117      coop_q_t *q;
 118      coop_t *t;
 119 #endif
 120 {
 121   q->tail->next = t;
 122   t->next = &q->t;
 123   q->tail = t;
 124 }
 125
 126 #ifdef __STDC__
 127 static void
 128 coop_all_qput (coop_q_t *q, coop_t *t)
 129 #else
 130 static void
 131 coop_all_qput (q, t)
 132      coop_q_t *q;
 133      coop_t *t;
 134 #endif
 135 {
 136   if (q->t.all_next)
 137     q->t.all_next->all_prev = t;
 138   t->all_prev = NULL;
 139   t->all_next = q->t.all_next;
 140   q->t.all_next = t;
 141 }
 142
 143 #ifdef __STDC__
 144 static void
 145 coop_all_qremove (coop_q_t *q, coop_t *t)
 146 #else
 147 static void
 148 coop_all_qremove (q, t)
 149      coop_q_t *q;
 150      coop_t *t;
 151 #endif
 152 {
 153   if (t->all_prev)
 154     t->all_prev->all_next = t->all_next;
 155   else
 156     q->t.all_next = t->all_next;
 157   if (t->all_next)
 158       t->all_next->all_prev = t->all_prev;
 159 }
 160
 161
 162 \f/* Thread routines. */
 163
 164 coop_q_t coop_global_runq;      /* A queue of runable threads. */
 165 coop_q_t coop_global_sleepq;    /* A queue of sleeping threads. */
 166 coop_q_t coop_tmp_queue;        /* A temp working queue */
 167 coop_q_t coop_global_allq;      /* A queue of all threads. */
 168 static coop_t coop_global_main; /* Thread for the process. */
 169 coop_t *coop_global_curr;       /* Currently-executing thread. */
 170
 171 static void *coop_starthelp (qt_t *old, void *ignore0, void *ignore1);
 172 static void coop_only (void *pu, void *pt, qt_userf_t *f);
 173 static void *coop_aborthelp (qt_t *sp, void *old, void *null);
 174 static void *coop_yieldhelp (qt_t *sp, void *old, void *blockq);
 175
 176
 177 #ifdef __STDC__
 178 void
 179 coop_init()
 180 #else
 181 void
 182 coop_init()
 183 #endif
 184 {
 185   coop_qinit (&coop_global_runq);
 186   coop_qinit (&coop_global_sleepq);
 187   coop_qinit (&coop_tmp_queue);
 188   coop_qinit (&coop_global_allq);
 189   coop_global_curr = &coop_global_main;
 190 }
 191
 192
 193 /* Return the next runnable thread. If no threads are currently runnable,
 194    and there are sleeping threads - wait until one wakes up. Otherwise,
 195    return NULL. */
 196
 197 #ifndef GUILE_ISELECT
 198 #ifdef __STDC__
 199 coop_t *
 200 coop_next_runnable_thread()
 201 #else
 202 coop_t *
 203 coop_next_runnable_thread()
 204 #endif
 205 {
 206   int sleepers;
 207   coop_t *t;
 208   time_t now;
 209
 210   do {
 211     sleepers = 0;
 212     now = time(NULL);
 213
 214     /* Check the sleeping queue */
 215     while ((t = coop_qget(&coop_global_sleepq)) != NULL)
 216       {
 217         sleepers++;
 218         if (t->wakeup_time <= now)
 219           coop_qput(&coop_global_runq, t);
 220         else
 221           coop_qput(&coop_tmp_queue, t);
 222       }
 223     while ((t = coop_qget(&coop_tmp_queue)) != NULL)
 224       coop_qput(&coop_global_sleepq, t);
 225
 226     t = coop_qget (&coop_global_runq);
 227
 228   } while ((t == NULL) && (sleepers > 0));
 229
 230   return t;
 231 }
 232 #endif
 233
 234 #ifdef __STDC__
 235 void
 236 coop_start()
 237 #else
 238 void
 239 coop_start()
 240 #endif
 241 {
 242   coop_t *next;
 243
 244   while ((next = coop_qget (&coop_global_runq)) != NULL) {
 245     coop_global_curr = next;
 246     QT_BLOCK (coop_starthelp, 0, 0, next->sp);
 247   }
 248 }
 249
 250
 251 #ifdef __STDC__
 252 static void *
 253 coop_starthelp (qt_t *old, void *ignore0, void *ignore1)
 254 #else
 255 static void *
 256 coop_starthelp (old, ignore0, ignore1)
 257      qt_t *old;
 258      void *ignore0;
 259      void *ignore1;
 260 #endif
 261 {
 262   coop_global_main.sp = old;
 263   coop_global_main.joining = NULL;
 264   coop_qput (&coop_global_runq, &coop_global_main);
 265   return NULL; /* not used, but keeps compiler happy */
 266 }
 267
 268 #ifdef __STDC__
 269 int
 270 coop_mutex_init (coop_m *m)
 271 #else
 272 int
 273 coop_mutex_init (m)
 274      coop_m *m;
 275 #endif
 276 {
 277   m->owner = NULL;
 278   coop_qinit(&(m->waiting));
 279   return 0;
 280 }
 281
 282 #ifdef __STDC__
 283 int
 284 coop_mutex_lock (coop_m *m)
 285 #else
 286 int
 287 coop_mutex_lock ()
 288      coop_m *m;
 289 #endif
 290 {
 291   if (m->owner == NULL)
 292     {
 293       m->owner = coop_global_curr;
 294     }
 295   else
 296     {
 297       coop_t *old, *newthread;
 298
 299       /* Record the current top-of-stack before going to sleep */
 300       coop_global_curr->top = &old;
 301
 302 #ifdef GUILE_ISELECT
 303       newthread = coop_wait_for_runnable_thread();
 304       if (newthread == coop_global_curr)
 305         coop_abort ();
 306 #else
 307       newthread = coop_next_runnable_thread();
 308 #endif
 309       old = coop_global_curr;
 310       coop_global_curr = newthread;
 311       QT_BLOCK (coop_yieldhelp, old, &(m->waiting), newthread->sp);
 312     }
 313   return 0;
 314 }
 315
 316
 317 #ifdef __STDC__
 318 int
 319 coop_mutex_unlock (coop_m *m)
 320 #else
 321 int
 322 coop_mutex_unlock (m)
 323      coop_m *m;
 324 #endif
 325 {
 326   coop_t *old, *newthread;
 327
 328   newthread = coop_qget (&(m->waiting));
 329   if (newthread != NULL)
 330     {
 331       /* Record the current top-of-stack before going to sleep */
 332       coop_global_curr->top = &old;
 333
 334       old = coop_global_curr;
 335       coop_global_curr = newthread;
 336       /* The new thread came into m->waiting through a lock operation.
 337          It now owns this mutex. */
 338       m->owner = coop_global_curr;
 339       QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
 340     }
 341   else
 342     {
 343       m->owner = NULL;
 344     }
 345   return 0;
 346 }
 347
 348
 349 #ifdef __STDC__
 350 int
 351 coop_mutex_destroy (coop_m *m)
 352 #else
 353 int
 354 coop_mutex_destroy (m)
 355      coop_m *m;
 356 #endif
 357 {
 358   return 0;
 359 }
 360
 361
 362 #ifdef __STDC__
 363 int
 364 coop_condition_variable_init (coop_c *c)
 365 #else
 366 int
 367 coop_condition_variable_init (c)
 368      coop_c *c;
 369 #endif
 370 {
 371   coop_qinit(&(c->waiting));
 372   return 0;
 373 }
 374
 375 #ifdef __STDC__
 376 int
 377 coop_condition_variable_wait_mutex (coop_c *c, coop_m *m)
 378 #else
 379 int
 380 coop_condition_variable_wait_mutex (c, m)
 381      coop_c *c;
 382      coop_m *m;
 383 #endif
 384 {
 385   coop_t *old, *newthread;
 386
 387   /* coop_mutex_unlock (m); */
 388   newthread = coop_qget (&(m->waiting));
 389   if (newthread != NULL)
 390     {
 391       m->owner = newthread;
 392     }
 393   else
 394     {
 395       m->owner = NULL;
 396 #ifdef GUILE_ISELECT
 397       newthread = coop_wait_for_runnable_thread();
 398       if (newthread == coop_global_curr)
 399         coop_abort ();
 400 #else
 401       newthread = coop_next_runnable_thread();
 402 #endif
 403     }
 404   coop_global_curr->top = &old;
 405   old = coop_global_curr;
 406   coop_global_curr = newthread;
 407   QT_BLOCK (coop_yieldhelp, old, &(c->waiting), newthread->sp);
 408
 409   coop_mutex_lock (m);
 410   return 0;
 411 }
 412
 413
 414 #ifdef __STDC__
 415 int
 416 coop_condition_variable_signal (coop_c *c)
 417 #else
 418 int
 419 coop_condition_variable_signal (c)
 420      coop_c *c;
 421 #endif
 422 {
 423   coop_t *newthread;
 424
 425   while ((newthread = coop_qget (&(c->waiting))) != NULL)
 426     {
 427       coop_qput (&coop_global_runq, newthread);
 428     }
 429   return 0;
 430 }
 431
 432
 433 #ifdef __STDC__
 434 int
 435 coop_condition_variable_destroy (coop_c *c)
 436 #else
 437 int
 438 coop_condition_variable_destroy (c)
 439      coop_c *c;
 440 #endif
 441 {
 442   return 0;
 443 }
 444
 445
 446 #ifdef __STDC__
 447 coop_t *
 448 coop_create (coop_userf_t *f, void *pu)
 449 #else
 450 coop_t *
 451 coop_create (f, pu)
 452      coop_userf_t *f;
 453      void *pu;
 454 #endif
 455 {
 456   coop_t *t;
 457   void *sto;
 458
 459   t = malloc (sizeof(coop_t));
 460
 461   t->data = NULL;
 462   t->sto = malloc (COOP_STKSIZE);
 463   sto = COOP_STKALIGN (t->sto, QT_STKALIGN);
 464   t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN);
 465   t->base = t->sp;
 466   t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, coop_only);
 467   t->joining = NULL;
 468   coop_qput (&coop_global_runq, t);
 469   coop_all_qput (&coop_global_allq, t);
 470
 471   return t;
 472 }
 473
 474
 475 #ifdef __STDC__
 476 static void
 477 coop_only (void *pu, void *pt, qt_userf_t *f)
 478 #else
 479 static void
 480 coop_only (pu. pt, f)
 481      void *pu,
 482      void *pt,
 483      qt_userf_t *f;
 484 #endif
 485 {
 486   coop_global_curr = (coop_t *)pt;
 487   (*(coop_userf_t *)f)(pu);
 488   coop_abort();
 489   /* NOTREACHED */
 490 }
 491
 492
 493 #ifdef __STDC__
 494 void
 495 coop_abort ()
 496 #else
 497 void
 498 coop_abort ()
 499 #endif
 500 {
 501   coop_t *old, *newthread;
 502
 503   /* Wake up any threads that are waiting to join this one */
 504   if (coop_global_curr->joining)
 505     {
 506       while ((newthread = coop_qget ((coop_q_t *)(coop_global_curr->joining)))
 507              != NULL)
 508         {
 509           coop_qput (&coop_global_runq, newthread);
 510         }
 511       free(coop_global_curr->joining);
 512     }
 513
 514 #ifdef GUILE_ISELECT
 515   scm_I_am_dead = 1;
 516   do {
 517     newthread = coop_wait_for_runnable_thread();
 518   } while (newthread == coop_global_curr);
 519   scm_I_am_dead = 0;
 520 #else
 521   newthread = coop_next_runnable_thread();
 522 #endif
 523   coop_all_qremove(&coop_global_allq, coop_global_curr);
 524   old = coop_global_curr;
 525   coop_global_curr = newthread;
 526   QT_ABORT (coop_aborthelp, old, (void *)NULL, newthread->sp);
 527 }
 528
 529
 530 #ifdef __STDC__
 531 static void *
 532 coop_aborthelp (qt_t *sp, void *old, void *null)
 533 #else
 534 static void *
 535 coop_aborthelp (sp, old, null)
 536      qt_t *sp;
 537      void *old;
 538      void *null;
 539 #endif
 540 {
 541   coop_t *oldthread = (coop_t *) old;
 542
 543   free (oldthread->sto);
 544
 545   /* "old" is freed in scm_threads_thread_die().
 546      Marking old->base NULL indicates that this thread is dead */
 547
 548   oldthread->base = NULL;
 549
 550   return NULL;
 551 }
 552
 553
 554 #ifdef __STDC__
 555 void
 556 coop_join(coop_t *t)
 557 #else
 558 void
 559 coop_join()
 560      coop_t *t;
 561 #endif
 562 {
 563   coop_t *old, *newthread;
 564
 565   /* Check if t is already finished */
 566   if (t->base == NULL)
 567     return;
 568
 569   /* Create a join list if necessary */
 570   if (t->joining == NULL)
 571     {
 572       t->joining = malloc(sizeof(coop_q_t));
 573       coop_qinit((coop_q_t *) t->joining);
 574     }
 575
 576 #ifdef GUILE_ISELECT
 577   newthread = coop_wait_for_runnable_thread();
 578   if (newthread == coop_global_curr)
 579     return;
 580 #else
 581   newthread = coop_next_runnable_thread();
 582 #endif
 583   old = coop_global_curr;
 584   coop_global_curr = newthread;
 585   QT_BLOCK (coop_yieldhelp, old, (coop_q_t *) t->joining, newthread->sp);
 586 }
 587
 588 #ifdef __STDC__
 589 void
 590 coop_yield()
 591 #else
 592 void
 593 coop_yield()
 594 #endif
 595 {
 596   coop_t *old = NULL;
 597   coop_t *newthread;
 598
 599   newthread = coop_next_runnable_thread();
 600
 601   /* There may be no other runnable threads. Return if this is the
 602      case. */
 603 #if GUILE_ISELECT
 604   if (newthread == coop_global_curr)
 605       return;
 606 #else
 607   if (newthread == NULL)
 608       return;
 609 #endif
 610
 611   old = coop_global_curr;
 612
 613   coop_global_curr = newthread;
 614   QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
 615 }
 616
 617
 618 #ifdef __STDC__
 619 static void *
 620 coop_yieldhelp (qt_t *sp, void *old, void *blockq)
 621 #else
 622 static void *
 623 coop_yieldhelp (sp, old, blockq)
 624      qt_t *sp;
 625      void *old;
 626      void *blockq;
 627 #endif
 628 {
 629   ((coop_t *)old)->sp = sp;
 630   coop_qput ((coop_q_t *)blockq, (coop_t *)old);
 631   return NULL;
 632 }
 633
 634 /* Replacement for the system's sleep() function. Does the right thing
 635    for the process - but not for the system (it busy-waits) */
 636
 637 void *
 638 coop_sleephelp (qt_t *sp, void *old, void *blockq)
 639 {
 640   ((coop_t *)old)->sp = sp;
 641   /* old is already on the sleep queue - so there's no need to
 642      do anything extra here */
 643   return NULL;
 644 }
 645
 646 #ifdef GUILE_ISELECT
 647
 648 unsigned long
 649 scm_thread_usleep (unsigned long usec)
 650 {
 651   struct timeval timeout;
 652   timeout.tv_sec = 0;
 653   timeout.tv_usec = usec;
 654   scm_internal_select (0, NULL, NULL, NULL, &timeout);
 655   return 0;  /* Maybe we should calculate actual time slept,
 656                 but this is faster... :) */
 657 }
 658
 659 unsigned long
 660 scm_thread_sleep (unsigned long sec)
 661 {
 662   time_t now = time (NULL);
 663   struct timeval timeout;
 664   unsigned long slept;
 665   timeout.tv_sec = sec;
 666   timeout.tv_usec = 0;
 667   scm_internal_select (0, NULL, NULL, NULL, &timeout);
 668   slept = time (NULL) - now;
 669   return slept > sec ? 0 : sec - slept;
 670 }
 671
 672 #else /* GUILE_ISELECT */
 673
 674 unsigned long
 675 scm_thread_sleep (unsigned long s)
 676 {
 677   coop_t *newthread, *old;
 678   time_t now = time (NULL);
 679   coop_global_curr->wakeup_time = now + s;
 680
 681   /* Put the current thread on the sleep queue */
 682   coop_qput (&coop_global_sleepq, coop_global_curr);
 683
 684   newthread = coop_next_runnable_thread();
 685
 686   /* If newthread is the same as the sleeping thread, do nothing */
 687   if (newthread == coop_global_curr)
 688     return s;
 689
 690   old = coop_global_curr;
 691
 692   coop_global_curr = newthread;
 693   QT_BLOCK (coop_sleephelp, old, NULL, newthread->sp);
 694
 695   return s;
 696 }
 697
 698 unsigned long
 699 scm_thread_usleep (unsigned long usec)
 700 {
 701   /* We're so cheap.  */
 702   scm_thread_sleep (usec / 1000000);
 703   struct timeval timeout;
 704   return 0;  /* Maybe we should calculate actual time slept,
 705                 but this is faster... :) */
 706 }
 707
 708 #endif /* GUILE_ISELECT */