[bpt/guile.git] / libguile / coop.c

/*	Copyright (C) 1995, 1996 Free Software Foundation, Inc.
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.  
 */
\f

/* $Id: coop.c,v 1.1 1997-04-15 01:34:30 jimb Exp $ */

/* Cooperative thread library, based on QuickThreads */

#include <qt.h>

#define COOP_STKSIZE (0x10000)

/* `alignment' must be a power of 2. */
#define COOP_STKALIGN(sp, alignment) \
((void *)((((qt_word_t)(sp)) + (alignment) - 1) & ~((alignment)-1)))

\f

/* Queue access functions. */

#ifdef __STDC__
static void
coop_qinit (coop_q_t *q)
#else
static void
coop_qinit (q)
     coop_q_t *q;
#endif
{
  q->t.next = q->tail = &q->t;

  q->t.all_prev = NULL;
  q->t.all_next = NULL;
}


#ifdef __STDC__
static coop_t *
coop_qget (coop_q_t *q)
#else
static coop_t *
coop_qget (q)
     coop_q_t *q;
#endif
{
  coop_t *t;

  t = q->t.next;
  q->t.next = t->next;
  if (t->next == &q->t) {
    if (t == &q->t) {		/* If it was already empty .. */
      return (NULL);		/* .. say so. */
    }
    q->tail = &q->t;		/* Else now it is empty. */
  }
  return (t);
}


#ifdef __STDC__
static void
coop_qput (coop_q_t *q, coop_t *t)
#else
static void
coop_qput (q, t)
     coop_q_t *q;
     coop_t *t;
#endif
{
  q->tail->next = t;
  t->next = &q->t;
  q->tail = t;
}

#ifdef __STDC__
static void
coop_all_qput (coop_q_t *q, coop_t *t)
#else
static void
coop_all_qput (q, t)
     coop_q_t *q;
     coop_t *t;
#endif
{
  if (q->t.all_next)
    q->t.all_next->all_prev = t;
  t->all_prev = NULL;
  t->all_next = q->t.all_next;
  q->t.all_next = t;
}

#ifdef __STDC__
static void
coop_all_qremove (coop_q_t *q, coop_t *t)
#else
static void
coop_all_qremove (q, t)
     coop_q_t *q;
     coop_t *t;
#endif
{
  if (t->all_prev)
    t->all_prev->all_next = t->all_next;
  else
    q->t.all_next = t->all_next;
  if (t->all_next)
      t->all_next->all_prev = t->all_prev;
}


\f/* Thread routines. */

coop_q_t coop_global_runq;		 /* A queue of runable threads. */
coop_q_t coop_global_sleepq;	 /* A queue of sleeping threads. */
static coop_q_t tmp_queue;	         /* A temp working queue */
coop_q_t coop_global_allq;  /* A queue of all threads. */
static coop_t coop_global_main;    /* Thread for the process. */
coop_t *coop_global_curr;	 /* Currently-executing thread. */

static void *coop_starthelp (qt_t *old, void *ignore0, void *ignore1);
static void coop_only (void *pu, void *pt, qt_userf_t *f);
static void *coop_aborthelp (qt_t *sp, void *old, void *null);
static void *coop_yieldhelp (qt_t *sp, void *old, void *blockq);


#ifdef __STDC__
void
coop_init()
#else
void
coop_init()
#endif
{
  coop_qinit (&coop_global_runq);
  coop_qinit (&coop_global_sleepq);
  coop_qinit (&tmp_queue);
  coop_qinit (&coop_global_allq);
  coop_global_curr = &coop_global_main;
}


/* Return the next runnable thread. If no threads are currently runnable,
   and there are sleeping threads - wait until one wakes up. Otherwise,
   return NULL. */

#ifdef __STDC__
coop_t *
coop_next_runnable_thread()
#else
coop_t *
coop_next_runnable_thread()
#endif
{
  int sleepers;
  coop_t *t;
  time_t now;

  do {
    sleepers = 0;
    now = time(NULL);

    /* Check the sleeping queue */
    while ((t = coop_qget(&coop_global_sleepq)) != NULL)
      {
	sleepers++;
	if (t->wakeup_time <= now)
	  coop_qput(&coop_global_runq, t);
	else
	  coop_qput(&tmp_queue, t);
      }
    while ((t = coop_qget(&tmp_queue)) != NULL)
      coop_qput(&coop_global_sleepq, t);
    
    t = coop_qget (&coop_global_runq);

  } while ((t == NULL) && (sleepers > 0));

  return t;
}


#ifdef __STDC__
void
coop_start()
#else
void
coop_start()
#endif
{
  coop_t *next;

  while ((next = coop_qget (&coop_global_runq)) != NULL) {
    coop_global_curr = next;
    QT_BLOCK (coop_starthelp, 0, 0, next->sp);
  }
}


#ifdef __STDC__
static void *
coop_starthelp (qt_t *old, void *ignore0, void *ignore1)
#else
static void *
coop_starthelp (old, ignore0, ignore1)
     qt_t *old;
     void *ignore0;
     void *ignore1;
#endif
{
  coop_global_main.sp = old;
  coop_global_main.joining = NULL;
  coop_qput (&coop_global_runq, &coop_global_main);
  return NULL; /* not used, but keeps compiler happy */
}

#ifdef __STDC__
void 
coop_mutex_init (coop_m *m)
#else
void 
coop_mutex_init (m)
     coop_m *m;
#endif
{
  m->owner = NULL;
  coop_qinit(&(m->waiting));
}

#ifdef __STDC__
void 
coop_mutex_lock (coop_m *m)
#else
void 
coop_mutex_lock ()
     coop_m *m;
#endif
{
  if (m->owner == NULL)
    {
      m->owner = coop_global_curr;
    }
  else
    {
      coop_t *old, *newthread;

      /* Record the current top-of-stack before going to sleep */
      coop_global_curr->top = &old;

      newthread = coop_next_runnable_thread();
      old = coop_global_curr;
      coop_global_curr = newthread;
      QT_BLOCK (coop_yieldhelp, old, &(m->waiting), newthread->sp);
    }
}


#ifdef __STDC__
void 
coop_mutex_unlock (coop_m *m)
#else
void 
coop_mutex_unlock (m)
     coop_m *m;
#endif
{
  coop_t *old, *newthread;
  
  newthread = coop_qget (&(m->waiting));
  if (newthread != NULL)
    {
      /* Record the current top-of-stack before going to sleep */
      coop_global_curr->top = &old;

      old = coop_global_curr;
      coop_global_curr = newthread;
      m->owner = coop_global_curr;
      QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
    }
  else
    {
      m->owner = NULL;
    }
}


#ifdef __STDC__
void 
coop_condition_variable_init (coop_c *c)
#else
void 
coop_condition_variable_init (c)
     coop_c *c;
#endif
{
  coop_qinit(&(c->waiting));
}

#ifdef __STDC__
void 
coop_condition_variable_wait (coop_c *c)
#else
void 
coop_condition_variable_wait (c)
     coop_c *c;
#endif
{
  coop_t *old, *newthread;

  newthread = coop_next_runnable_thread();
  old = coop_global_curr;
  coop_global_curr = newthread;
  QT_BLOCK (coop_yieldhelp, old, &(c->waiting), newthread->sp);
}

#ifdef __STDC__
void 
coop_condition_variable_signal (coop_c *c)
#else
void 
coop_condition_variable_signal (c)
     coop_c *c;
#endif
{
  coop_t *newthread;

  while ((newthread = coop_qget (&(c->waiting))) != NULL)
    {
      coop_qput (&coop_global_runq, newthread);
    }
}


#ifdef __STDC__
coop_t *
coop_create (coop_userf_t *f, void *pu)
#else
coop_t *
coop_create (f, pu)
     coop_userf_t *f;
     void *pu;
#endif
{
  coop_t *t;
  void *sto;

  t = malloc (sizeof(coop_t));

  t->data = NULL;
  t->sto = malloc (COOP_STKSIZE);
  sto = COOP_STKALIGN (t->sto, QT_STKALIGN);
  t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN);
  t->base = t->sp;
  t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, coop_only);
  t->joining = NULL;
  coop_qput (&coop_global_runq, t);
  coop_all_qput (&coop_global_allq, t);

  return t;
}


#ifdef __STDC__
static void
coop_only (void *pu, void *pt, qt_userf_t *f)
#else
static void
coop_only (pu. pt, f)
     void *pu, 
     void *pt, 
     qt_userf_t *f;
#endif
{
  coop_global_curr = (coop_t *)pt;
  (*(coop_userf_t *)f)(pu);
  coop_abort();
  /* NOTREACHED */
}


#ifdef __STDC__
void
coop_abort ()
#else
void
coop_abort ()
#endif
{
  coop_t *old, *newthread;

  /* Wake up any threads that are waiting to join this one */
  if (coop_global_curr->joining)
    {
      while ((newthread = coop_qget ((coop_q_t *)(coop_global_curr->joining)))
	     != NULL)
	{
	  coop_qput (&coop_global_runq, newthread);
	}
      free(coop_global_curr->joining);
    }

  newthread = coop_next_runnable_thread();
  coop_all_qremove(&coop_global_allq, coop_global_curr);
  old = coop_global_curr;
  coop_global_curr = newthread;
  QT_ABORT (coop_aborthelp, old, (void *)NULL, newthread->sp);
}


#ifdef __STDC__
static void *
coop_aborthelp (qt_t *sp, void *old, void *null)
#else
static void *
coop_aborthelp (sp, old, null)
     qt_t *sp;
     void *old;
     void *null;
#endif
{
  coop_t *oldthread = (coop_t *) old;

  free (oldthread->sto);

  /* "old" is freed in scm_threads_thread_die().
     Marking old->base NULL indicates that this thread is dead */

  oldthread->base = NULL;

  return NULL;
}


#ifdef __STDC__
void 
coop_join(coop_t *t)
#else
void 
coop_join()
     coop_t *t;
#endif
{
  coop_t *old, *newthread;
  
  /* Check if t is already finished */
  if (t->base == NULL)
    return;

  /* Create a join list if necessary */
  if (t->joining == NULL)
    {
      t->joining = malloc(sizeof(coop_q_t));
      coop_qinit((coop_q_t *) t->joining);
    }

  newthread = coop_next_runnable_thread();
  old = coop_global_curr;
  coop_global_curr = newthread;
  QT_BLOCK (coop_yieldhelp, old, (coop_q_t *) t->joining, newthread->sp);
}

#ifdef __STDC__
void
coop_yield()
#else
void
coop_yield()
#endif
{
  coop_t *old = NULL;
  coop_t *newthread;

  newthread = coop_next_runnable_thread();

  /* There may be no other runnable threads. Return if this is the 
     case. */
  if (newthread == NULL)
      return;

  old = coop_global_curr;

  coop_global_curr = newthread;
  QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
}


#ifdef __STDC__
static void *
coop_yieldhelp (qt_t *sp, void *old, void *blockq)
#else
static void *
coop_yieldhelp (sp, old, blockq)
     qt_t *sp;
     void *old;
     void *blockq;
#endif
{
  ((coop_t *)old)->sp = sp;
  coop_qput ((coop_q_t *)blockq, (coop_t *)old);
  return NULL;
}

/* Replacement for the system's sleep() function. Does the right thing
   for the process - but not for the system (it busy-waits) */

#ifdef __STDC__
static void *
coop_sleephelp (qt_t *sp, void *old, void *blockq)
#else
static void *
coop_sleephelp (sp, old, bolckq)
     qt_t *sp;
     void *old;
     void *blockq;
#endif
{
  ((coop_t *)old)->sp = sp;
  /* old is already on the sleep queue - so there's no need to
     do anything extra here */
  return NULL;
}

#ifdef __STDC__
unsigned
sleep (unsigned s)
#else
unsigned
sleep (s)
     unsigned s;
#endif
{
  coop_t *newthread, *old;
  time_t now = time(NULL);
  coop_global_curr->wakeup_time = now + s;

  /* Put the current thread on the sleep queue */
  coop_qput (&coop_global_sleepq, coop_global_curr);

  newthread = coop_next_runnable_thread();

  /* If newthread is the same as the sleeping thread, do nothing */
  if (newthread == coop_global_curr)
    return s;

  old = coop_global_curr;

  coop_global_curr = newthread;
  QT_BLOCK (coop_sleephelp, old, NULL, newthread->sp);

  return s;
}
Commit	Line	Data
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
	15	* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
	16	*
	17	* As a special exception, the Free Software Foundation gives permission
	18	* for additional uses of the text contained in its release of GUILE.
	19	*
	20	* The exception is that, if you link the GUILE library with other files
	21	* to produce an executable, this does not by itself cause the
	22	* resulting executable to be covered by the GNU General Public License.
	23	* Your use of that executable is in no way restricted on account of
	24	* linking the GUILE library code into it.
	25	*
	26	* This exception does not however invalidate any other reasons why
	27	* the executable file might be covered by the GNU General Public License.
	28	*
	29	* This exception applies only to the code released by the
	30	* Free Software Foundation under the name GUILE. If you copy
	31	* code from other Free Software Foundation releases into a copy of
	32	* GUILE, as the General Public License permits, the exception does
	33	* not apply to the code that you add in this way. To avoid misleading
	34	* anyone as to the status of such modified files, you must delete
	35	* this exception notice from them.
	36	*
	37	* If you write modifications of your own for GUILE, it is your choice
	38	* whether to permit this exception to apply to your modifications.
	39	* If you do not wish that, delete this exception notice.
	40	*/
	41	\f
	42
	43	/* $Id: coop.c,v 1.1 1997-04-15 01:34:30 jimb Exp $ */
	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__
	60	static void
	61	coop_qinit (coop_q_t *q)
	62	#else
	63	static void
	64	coop_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;
72	}
73
74
75	#ifdef __STDC__
76	static coop_t *
77	coop_qget (coop_q_t *q)
78	#else
79	static coop_t *
80	coop_qget (q)
81	coop_q_t *q;
82	#endif
83	{
84	coop_t *t;
85
86	t = q->t.next;
87	q->t.next = t->next;
88	if (t->next == &q->t) {
89	if (t == &q->t) { /* If it was already empty .. */
90	return (NULL); /* .. say so. */
91	}
92	q->tail = &q->t; /* Else now it is empty. */
93	}
94	return (t);
95	}
96
97
98	#ifdef __STDC__
99	static void
100	coop_qput (coop_q_t q, coop_t t)
101	#else
102	static void
103	coop_qput (q, t)
104	coop_q_t *q;
105	coop_t *t;
106	#endif
107	{
108	q->tail->next = t;
109	t->next = &q->t;
110	q->tail = t;
111	}
112
113	#ifdef __STDC__
114	static void
115	coop_all_qput (coop_q_t q, coop_t t)
116	#else
117	static void
118	coop_all_qput (q, t)
119	coop_q_t *q;
120	coop_t *t;
121	#endif
122	{
123	if (q->t.all_next)
124	q->t.all_next->all_prev = t;
125	t->all_prev = NULL;
126	t->all_next = q->t.all_next;
127	q->t.all_next = t;
128	}
129
130	#ifdef __STDC__
131	static void
132	coop_all_qremove (coop_q_t q, coop_t t)
133	#else
134	static void
135	coop_all_qremove (q, t)
136	coop_q_t *q;
137	coop_t *t;
138	#endif
139	{
140	if (t->all_prev)
141	t->all_prev->all_next = t->all_next;
142	else
143	q->t.all_next = t->all_next;
144	if (t->all_next)
145	t->all_next->all_prev = t->all_prev;
146	}
147
148
149	\f/* Thread routines. */
150
151	coop_q_t coop_global_runq; /* A queue of runable threads. */
152	coop_q_t coop_global_sleepq; /* A queue of sleeping threads. */
153	static coop_q_t tmp_queue; /* A temp working queue */
154	coop_q_t coop_global_allq; /* A queue of all threads. */
155	static coop_t coop_global_main; /* Thread for the process. */
156	coop_t coop_global_curr; / Currently-executing thread. */
157
158	static void coop_starthelp (qt_t old, void ignore0, void ignore1);
159	static void coop_only (void pu, void pt, qt_userf_t *f);
160	static void coop_aborthelp (qt_t sp, void old, void null);
161	static void coop_yieldhelp (qt_t sp, void old, void blockq);
162
163
164	#ifdef __STDC__
165	void
166	coop_init()
167	#else
168	void
169	coop_init()
170	#endif
171	{
172	coop_qinit (&coop_global_runq);
173	coop_qinit (&coop_global_sleepq);
174	coop_qinit (&tmp_queue);
175	coop_qinit (&coop_global_allq);
176	coop_global_curr = &coop_global_main;
177	}
178
179
180	/* Return the next runnable thread. If no threads are currently runnable,
181	and there are sleeping threads - wait until one wakes up. Otherwise,
182	return NULL. */
183
184	#ifdef __STDC__
185	coop_t *
186	coop_next_runnable_thread()
187	#else
188	coop_t *
189	coop_next_runnable_thread()
190	#endif
191	{
192	int sleepers;
193	coop_t *t;
194	time_t now;
195
196	do {
197	sleepers = 0;
198	now = time(NULL);
199
200	/* Check the sleeping queue */
201	while ((t = coop_qget(&coop_global_sleepq)) != NULL)
202	{
203	sleepers++;
204	if (t->wakeup_time <= now)
205	coop_qput(&coop_global_runq, t);
206	else
207	coop_qput(&tmp_queue, t);
208	}
209	while ((t = coop_qget(&tmp_queue)) != NULL)
210	coop_qput(&coop_global_sleepq, t);
211
212	t = coop_qget (&coop_global_runq);
213
214	} while ((t == NULL) && (sleepers > 0));
215
216	return t;
217	}
218
219
220	#ifdef __STDC__
221	void
222	coop_start()
223	#else
224	void
225	coop_start()
226	#endif
227	{
228	coop_t *next;
229
230	while ((next = coop_qget (&coop_global_runq)) != NULL) {
231	coop_global_curr = next;
232	QT_BLOCK (coop_starthelp, 0, 0, next->sp);
233	}
234	}
235
236
237	#ifdef __STDC__
238	static void *
239	coop_starthelp (qt_t old, void ignore0, void *ignore1)
240	#else
241	static void *
242	coop_starthelp (old, ignore0, ignore1)
243	qt_t *old;
244	void *ignore0;
245	void *ignore1;
246	#endif
247	{
248	coop_global_main.sp = old;
249	coop_global_main.joining = NULL;
250	coop_qput (&coop_global_runq, &coop_global_main);
251	return NULL; /* not used, but keeps compiler happy */
252	}
253
254	#ifdef __STDC__
255	void
256	coop_mutex_init (coop_m *m)
257	#else
258	void
259	coop_mutex_init (m)
260	coop_m *m;
261	#endif
262	{
263	m->owner = NULL;
264	coop_qinit(&(m->waiting));
265	}
266
267	#ifdef __STDC__
268	void
269	coop_mutex_lock (coop_m *m)
270	#else
271	void
272	coop_mutex_lock ()
273	coop_m *m;
274	#endif
275	{
276	if (m->owner == NULL)
277	{
278	m->owner = coop_global_curr;
279	}
280	else
281	{
282	coop_t old, newthread;
283
284	/* Record the current top-of-stack before going to sleep */
285	coop_global_curr->top = &old;
286
287	newthread = coop_next_runnable_thread();
288	old = coop_global_curr;
289	coop_global_curr = newthread;
290	QT_BLOCK (coop_yieldhelp, old, &(m->waiting), newthread->sp);
291	}
292	}
293
294
295	#ifdef __STDC__
296	void
297	coop_mutex_unlock (coop_m *m)
298	#else
299	void
300	coop_mutex_unlock (m)
301	coop_m *m;
302	#endif
303	{
304	coop_t old, newthread;
305
306	newthread = coop_qget (&(m->waiting));
307	if (newthread != NULL)
308	{
309	/* Record the current top-of-stack before going to sleep */
310	coop_global_curr->top = &old;
311
312	old = coop_global_curr;
313	coop_global_curr = newthread;
314	m->owner = coop_global_curr;
315	QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
316	}
317	else
318	{
319	m->owner = NULL;
320	}
321	}
322
323
324	#ifdef __STDC__
325	void
326	coop_condition_variable_init (coop_c *c)
327	#else
328	void
329	coop_condition_variable_init (c)
330	coop_c *c;
331	#endif
332	{
333	coop_qinit(&(c->waiting));
334	}
335
336	#ifdef __STDC__
337	void
338	coop_condition_variable_wait (coop_c *c)
339	#else
340	void
341	coop_condition_variable_wait (c)
342	coop_c *c;
343	#endif
344	{
345	coop_t old, newthread;
346
347	newthread = coop_next_runnable_thread();
348	old = coop_global_curr;
349	coop_global_curr = newthread;
350	QT_BLOCK (coop_yieldhelp, old, &(c->waiting), newthread->sp);
351	}
352
353	#ifdef __STDC__
354	void
355	coop_condition_variable_signal (coop_c *c)
356	#else
357	void
358	coop_condition_variable_signal (c)
359	coop_c *c;
360	#endif
361	{
362	coop_t *newthread;
363
364	while ((newthread = coop_qget (&(c->waiting))) != NULL)
365	{
366	coop_qput (&coop_global_runq, newthread);
367	}
368	}
369
370
371	#ifdef __STDC__
372	coop_t *
373	coop_create (coop_userf_t f, void pu)
374	#else
375	coop_t *
376	coop_create (f, pu)
377	coop_userf_t *f;
378	void *pu;
379	#endif
380	{
381	coop_t *t;
382	void *sto;
383
384	t = malloc (sizeof(coop_t));
385
386	t->data = NULL;
387	t->sto = malloc (COOP_STKSIZE);
388	sto = COOP_STKALIGN (t->sto, QT_STKALIGN);
389	t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN);
390	t->base = t->sp;
391	t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, coop_only);
392	t->joining = NULL;
393	coop_qput (&coop_global_runq, t);
394	coop_all_qput (&coop_global_allq, t);
395
396	return t;
397	}
398
399
400	#ifdef __STDC__
401	static void
402	coop_only (void pu, void pt, qt_userf_t *f)
403	#else
404	static void
405	coop_only (pu. pt, f)
406	void *pu,
407	void *pt,
408	qt_userf_t *f;
409	#endif
410	{
411	coop_global_curr = (coop_t *)pt;
412	((coop_userf_t )f)(pu);
413	coop_abort();
414	/* NOTREACHED */
415	}
416
417
418	#ifdef __STDC__
419	void
420	coop_abort ()
421	#else
422	void
423	coop_abort ()
424	#endif
425	{
426	coop_t old, newthread;
427
428	/* Wake up any threads that are waiting to join this one */
429	if (coop_global_curr->joining)
430	{
431	while ((newthread = coop_qget ((coop_q_t *)(coop_global_curr->joining)))
432	!= NULL)
433	{
434	coop_qput (&coop_global_runq, newthread);
435	}
436	free(coop_global_curr->joining);
437	}
438
439	newthread = coop_next_runnable_thread();
440	coop_all_qremove(&coop_global_allq, coop_global_curr);
441	old = coop_global_curr;
442	coop_global_curr = newthread;
443	QT_ABORT (coop_aborthelp, old, (void *)NULL, newthread->sp);
444	}
445
446
447	#ifdef __STDC__
448	static void *
449	coop_aborthelp (qt_t sp, void old, void *null)
450	#else
451	static void *
452	coop_aborthelp (sp, old, null)
453	qt_t *sp;
454	void *old;
455	void *null;
456	#endif
457	{
458	coop_t oldthread = (coop_t ) old;
459
460	free (oldthread->sto);
461
462	/* "old" is freed in scm_threads_thread_die().
463	Marking old->base NULL indicates that this thread is dead */
464
465	oldthread->base = NULL;
466
467	return NULL;
468	}
469
470
471	#ifdef __STDC__
472	void
473	coop_join(coop_t *t)
474	#else
475	void
476	coop_join()
477	coop_t *t;
478	#endif
479	{
480	coop_t old, newthread;
481
482	/* Check if t is already finished */
483	if (t->base == NULL)
484	return;
485
486	/* Create a join list if necessary */
487	if (t->joining == NULL)
488	{
489	t->joining = malloc(sizeof(coop_q_t));
490	coop_qinit((coop_q_t *) t->joining);
491	}
492
493	newthread = coop_next_runnable_thread();
494	old = coop_global_curr;
495	coop_global_curr = newthread;
496	QT_BLOCK (coop_yieldhelp, old, (coop_q_t *) t->joining, newthread->sp);
497	}
498
499	#ifdef __STDC__
500	void
501	coop_yield()
502	#else
503	void
504	coop_yield()
505	#endif
506	{
507	coop_t *old = NULL;
508	coop_t *newthread;
509
510	newthread = coop_next_runnable_thread();
511
512	/* There may be no other runnable threads. Return if this is the
513	case. */
514	if (newthread == NULL)
515	return;
516
517	old = coop_global_curr;
518
519	coop_global_curr = newthread;
520	QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
521	}
522
523
524	#ifdef __STDC__
525	static void *
526	coop_yieldhelp (qt_t sp, void old, void *blockq)
527	#else
528	static void *
529	coop_yieldhelp (sp, old, blockq)
530	qt_t *sp;
531	void *old;
532	void *blockq;
533	#endif
534	{
535	((coop_t *)old)->sp = sp;
536	coop_qput ((coop_q_t )blockq, (coop_t )old);
537	return NULL;
538	}
539
540	/* Replacement for the system's sleep() function. Does the right thing
541	for the process - but not for the system (it busy-waits) */
542
543	#ifdef __STDC__
544	static void *
545	coop_sleephelp (qt_t sp, void old, void *blockq)
546	#else
547	static void *
548	coop_sleephelp (sp, old, bolckq)
549	qt_t *sp;
550	void *old;
551	void *blockq;
552	#endif
553	{
554	((coop_t *)old)->sp = sp;
555	/* old is already on the sleep queue - so there's no need to
556	do anything extra here */
557	return NULL;
558	}
559
560	#ifdef __STDC__
561	unsigned
562	sleep (unsigned s)
563	#else
564	unsigned
565	sleep (s)
566	unsigned s;
567	#endif
568	{
569	coop_t newthread, old;
570	time_t now = time(NULL);
571	coop_global_curr->wakeup_time = now + s;
572
573	/* Put the current thread on the sleep queue */
574	coop_qput (&coop_global_sleepq, coop_global_curr);
575
576	newthread = coop_next_runnable_thread();
577
578	/* If newthread is the same as the sleeping thread, do nothing */
579	if (newthread == coop_global_curr)
580	return s;
581
582	old = coop_global_curr;
583
584	coop_global_curr = newthread;
585	QT_BLOCK (coop_sleephelp, old, NULL, newthread->sp);
586
587	return s;
588	}