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