1 /* Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
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)
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.
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
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
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.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
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.
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. */
53 #include "coop-threads.h"
55 #ifdef MISSING_BZERO_DECL
56 extern void bzero (void *, size_t);
61 /* COOP queue macros */
62 #define QEMPTYP(q) (q.t.next == &q.t)
63 #define QFIRST(q) (q.t.next)
65 /* These macros count the number of bits in a word. */
66 #define SCM_BITS_PER_LONG (8 * sizeof (unsigned long))
67 /* Use LONG_MAX instead of ULONG_MAX here since not all systems define
69 #if LONG_MAX >> 16 == 0
70 #define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\
71 + bc[((unsigned char *)(p))[1]])
72 #elif LONG_MAX >> 32 == 0
73 #define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\
74 + bc[((unsigned char *)(p))[1]]\
75 + bc[((unsigned char *)(p))[2]]\
76 + bc[((unsigned char *)(p))[3]])
77 #elif LONG_MAX >> 64 == 0
78 #define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\
79 + bc[((unsigned char *)(p))[1]]\
80 + bc[((unsigned char *)(p))[2]]\
81 + bc[((unsigned char *)(p))[3]]\
82 + bc[((unsigned char *)(p))[4]]\
83 + bc[((unsigned char *)(p))[5]]\
84 + bc[((unsigned char *)(p))[6]]\
85 + bc[((unsigned char *)(p))[7]])
89 #define FD_ZERO_N(pos, n) bzero ((pos), (n))
91 #define FD_ZERO_N(pos, n) memset ((void *) (pos), 0, (n))
94 typedef unsigned long *ulongptr
;
96 static char bc
[256]; /* Bit counting array. bc[x] is the number of
101 /* This flag indicates that several threads are waiting on the same
102 file descriptor. When this is the case, the common fd sets are
103 updated in a more inefficient way. */
106 /* These are the common fd sets. When new select calls are made,
107 those sets are merged into these. */
109 SELECT_TYPE greadfds
;
110 SELECT_TYPE gwritefds
;
111 SELECT_TYPE gexceptfds
;
113 /* These are the result sets. They are used when we call OS select.
114 We couldn't use the common fd sets above, since that would destroy
116 SELECT_TYPE rreadfds
;
117 SELECT_TYPE rwritefds
;
118 SELECT_TYPE rexceptfds
;
120 /* Constant timeval struct representing a zero timeout which we use
122 static struct timeval timeout0
;
124 /* As select, but doesn't destroy the file descriptor sets passed as
125 arguments. The results are stored into the result sets. */
127 safe_select (int nfds
,
128 SELECT_TYPE
*readfds
,
129 SELECT_TYPE
*writefds
,
130 SELECT_TYPE
*exceptfds
,
131 struct timeval
*timeout
)
133 int n
= (nfds
+ 7) / 8;
134 /* Copy file descriptor sets to result area */
139 memcpy (&rreadfds
, readfds
, n
);
140 FD_ZERO_N ((char *) &rreadfds
+ n
, SELECT_SET_SIZE
/ 8 - n
);
142 if (writefds
== NULL
)
143 FD_ZERO (&rwritefds
);
146 memcpy (&rwritefds
, writefds
, n
);
147 FD_ZERO_N ((char *) &rwritefds
+ n
, SELECT_SET_SIZE
/ 8 - n
);
149 if (exceptfds
== NULL
)
150 FD_ZERO (&rexceptfds
);
153 memcpy (&rexceptfds
, exceptfds
, n
);
154 FD_ZERO_N ((char *) &rexceptfds
+ n
, SELECT_SET_SIZE
/ 8 - n
);
156 return select (nfds
, &rreadfds
, &rwritefds
, &rexceptfds
, timeout
);
159 /* Merge new file descriptor sets into the common sets. */
161 add_fd_sets (coop_t
*t
)
163 int n
= (t
->nfds
+ SCM_BITS_PER_LONG
- 1) / SCM_BITS_PER_LONG
;
166 /* Detect if the fd sets of the thread have any bits in common with
167 the rest of the waiting threads. If that is so, set the
168 collision flag. This causes a more time consuming handling of
169 the common fd sets---they need to recalculated every time a
172 for (i
= 0; i
< n
; ++i
)
173 if ((t
->readfds
!= NULL
174 && (((ulongptr
) t
->readfds
)[i
] & ((ulongptr
) &greadfds
)[i
]) != 0)
175 || (t
->writefds
!= NULL
176 && ((((ulongptr
) t
->writefds
)[i
] & ((ulongptr
) &gwritefds
)[i
])
178 || (t
->exceptfds
!= NULL
179 && ((((ulongptr
) t
->exceptfds
)[i
] & ((ulongptr
) &gexceptfds
)[i
])
186 /* We recalculate nfds below. The cost for this can be paid back
187 with a great bonus since many programs are lazy with the nfds
188 arg. Many even pass 1024 when using one of the lowest fd:s!
190 We approach from above, checking for non-zero bits. As soon as
191 we have determined the value of nfds, we jump down to code below
192 which concludes the updating of the common sets. */
198 if (t
->readfds
!= NULL
&& ((ulongptr
) t
->readfds
)[i
] != 0)
200 ((ulongptr
) &greadfds
)[i
] |= ((ulongptr
) t
->readfds
)[i
];
201 n
= (i
+ 1) * SCM_BITS_PER_LONG
;
207 if (t
->writefds
!= NULL
&& ((ulongptr
) t
->writefds
)[i
] != 0)
209 ((ulongptr
) &gwritefds
)[i
] |= ((ulongptr
) t
->writefds
)[i
];
210 n
= (i
+ 1) * SCM_BITS_PER_LONG
;
216 if (t
->exceptfds
!= NULL
&& ((ulongptr
) t
->exceptfds
)[i
] != 0)
218 ((ulongptr
) &gexceptfds
)[i
] |= ((ulongptr
) t
->exceptfds
)[i
];
219 n
= (i
+ 1) * SCM_BITS_PER_LONG
;
228 /* nfds is now determined. Just finish updating the common sets. */
232 if (t
->readfds
!= NULL
&& ((ulongptr
) t
->readfds
)[i
] != 0)
233 ((ulongptr
) &greadfds
)[i
] |= ((ulongptr
) t
->readfds
)[i
];
235 if (t
->writefds
!= NULL
&& ((ulongptr
) t
->writefds
)[i
] != 0)
236 ((ulongptr
) &gwritefds
)[i
] |= ((ulongptr
) t
->writefds
)[i
];
238 if (t
->exceptfds
!= NULL
&& ((ulongptr
) t
->exceptfds
)[i
] != 0)
239 ((ulongptr
) &gexceptfds
)[i
] |= ((ulongptr
) t
->exceptfds
)[i
];
244 /* Update the fd sets pointed to by the thread so that they reflect
245 the status of the file descriptors which the thread was interested
246 in. Also clear those bits in the common sets. This function is
247 only called when there are no bit collisions. */
249 finalize_fd_sets (coop_t
*t
)
251 int i
= (t
->nfds
+ SCM_BITS_PER_LONG
- 1) / SCM_BITS_PER_LONG
;
253 register unsigned long s
;
255 if (t
->nfds
== gnfds
)
257 /* This thread is the one responsible for the current high value
258 of gnfds. First do our other jobs while at the same time
259 trying to decrease gnfds. */
263 if (t
->readfds
!= NULL
&& (s
= ((ulongptr
) t
->readfds
)[i
]) != 0)
265 ((ulongptr
) t
->readfds
)[i
] &= ((ulongptr
) &rreadfds
)[i
];
266 ((ulongptr
) &greadfds
)[i
] &= ~s
;
267 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->readfds
)[i
]);
269 if (((ulongptr
) &greadfds
)[i
] != 0)
271 gnfds
= (i
+ 1) * SCM_BITS_PER_LONG
;
274 if (t
->writefds
!= NULL
&& (s
= ((ulongptr
) t
->writefds
)[i
]) != 0)
276 ((ulongptr
) t
->writefds
)[i
] &= ((ulongptr
) &rwritefds
)[i
];
277 ((ulongptr
) &gwritefds
)[i
] &= ~s
;
278 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->writefds
)[i
]);
280 if (((ulongptr
) &gwritefds
)[i
] != 0)
282 gnfds
= (i
+ 1) * SCM_BITS_PER_LONG
;
285 if (t
->exceptfds
!= NULL
&& (s
= ((ulongptr
) t
->exceptfds
)[i
]) != 0)
287 ((ulongptr
) t
->exceptfds
)[i
] &= ((ulongptr
) &rexceptfds
)[i
];
288 ((ulongptr
) &gexceptfds
)[i
] &= ~s
;
289 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->exceptfds
)[i
]);
291 if (((ulongptr
) &gexceptfds
)[i
] != 0)
293 gnfds
= (i
+ 1) * SCM_BITS_PER_LONG
;
302 /* Either this thread wasn't responsible for gnfds or gnfds has been
307 if (t
->readfds
!= NULL
&& (s
= ((ulongptr
) t
->readfds
)[i
]) != 0)
309 ((ulongptr
) t
->readfds
)[i
] &= ((ulongptr
) &rreadfds
)[i
];
310 ((ulongptr
) &greadfds
)[i
] &= ~s
;
311 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->readfds
)[i
]);
314 if (t
->writefds
!= NULL
&& (s
= ((ulongptr
) t
->writefds
)[i
]) != 0)
316 ((ulongptr
) t
->writefds
)[i
] &= ((ulongptr
) &rwritefds
)[i
];
317 ((ulongptr
) &gwritefds
)[i
] &= ~s
;
318 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->writefds
)[i
]);
321 if (t
->exceptfds
!= NULL
&& (s
= ((ulongptr
) t
->exceptfds
)[i
]) != 0)
323 ((ulongptr
) t
->exceptfds
)[i
] &= ((ulongptr
) &rexceptfds
)[i
];
324 ((ulongptr
) &gexceptfds
)[i
] &= ~s
;
325 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->exceptfds
)[i
]);
333 /* Just like finalize_fd_sets except that we don't have to update the
334 global fd sets. Those will be recalulated elsewhere. */
336 finalize_fd_sets_lazily (coop_t
*t
)
338 int i
= (t
->nfds
+ SCM_BITS_PER_LONG
- 1) / SCM_BITS_PER_LONG
;
343 if (t
->readfds
!= NULL
&& ((ulongptr
) t
->readfds
)[i
] != 0)
345 ((ulongptr
) t
->readfds
)[i
] &= ((ulongptr
) &rreadfds
)[i
];
346 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->readfds
)[i
]);
348 if (t
->writefds
!= NULL
&& ((ulongptr
) t
->writefds
)[i
] != 0)
350 ((ulongptr
) t
->writefds
)[i
] &= ((ulongptr
) &rwritefds
)[i
];
351 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->writefds
)[i
]);
353 if (t
->exceptfds
!= NULL
&& ((ulongptr
) t
->exceptfds
)[i
] != 0)
355 ((ulongptr
) t
->exceptfds
)[i
] &= ((ulongptr
) &rexceptfds
)[i
];
356 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->exceptfds
)[i
]);
362 /* Return first fd with a non-zero bit in any of the result sets. */
364 first_interesting_fd (void)
370 if (((ulongptr
) &rreadfds
)[i
] != 0)
375 if (((ulongptr
) &rwritefds
)[i
] != 0)
380 if (((ulongptr
) &rexceptfds
)[i
] != 0)
387 i
*= SCM_BITS_PER_LONG
;
394 fprintf (stderr
, "first_interesting_fd: internal error\n");
398 /* Revive all threads with an error status. */
400 scm_error_revive_threads (void)
404 while ((t
= coop_qget (&coop_global_sleepq
)) != NULL
)
408 if (t
!= coop_global_curr
)
409 coop_qput (&coop_global_runq
, t
);
414 FD_ZERO (&gwritefds
);
415 FD_ZERO (&gexceptfds
);
418 /* Given the result of a call to safe_select and the current time,
419 try to wake up some threads and return the first one. Return NULL
420 if we couldn't find any. */
422 find_thread (int n
, struct timeval
*now
, int sleepingp
)
428 /* An error or a signal has occured. Wake all threads. Since we
429 don't care to calculate if there is a sinner we report the
430 error to all of them. */
432 scm_error_revive_threads ();
434 return coop_global_curr
;
438 while (!QEMPTYP (coop_global_sleepq
)
439 && (t
= QFIRST (coop_global_sleepq
))->timeoutp
440 && (t
->wakeup_time
.tv_sec
< now
->tv_sec
441 || (t
->wakeup_time
.tv_sec
== now
->tv_sec
442 && t
->wakeup_time
.tv_usec
<= now
->tv_usec
)))
444 coop_qget (&coop_global_sleepq
);
446 finalize_fd_sets_lazily (t
);
448 finalize_fd_sets (t
);
449 coop_qput (&coop_global_runq
, t
);
453 while ((t
= coop_qget (&coop_global_sleepq
)) != NULL
)
454 coop_qput (&coop_tmp_queue
, t
);
455 goto rebuild_global_fd_sets
;
460 /* Find the first interesting file descriptor */
461 fd
= first_interesting_fd ();
462 /* Check the sleeping queue for this file descriptor.
463 Other file descriptors will be handled next time
464 coop_next_runnable_thread is called. */
465 /* This code is inefficient. We'll improve it later. */
466 while ((t
= coop_qget (&coop_global_sleepq
)) != NULL
)
468 if ((t
->readfds
&& FD_ISSET (fd
, t
->readfds
))
469 || (t
->writefds
&& FD_ISSET (fd
, t
->writefds
))
470 || (t
->exceptfds
&& FD_ISSET (fd
, t
->exceptfds
))
472 && (t
->wakeup_time
.tv_sec
< now
->tv_sec
473 || (t
->wakeup_time
.tv_sec
== now
->tv_sec
474 && t
->wakeup_time
.tv_usec
<= now
->tv_usec
))))
477 finalize_fd_sets_lazily (t
);
479 finalize_fd_sets (t
);
480 coop_qput (&coop_global_runq
, t
);
483 coop_qput(&coop_tmp_queue
, t
);
487 rebuild_global_fd_sets
:
491 FD_ZERO (&gwritefds
);
492 FD_ZERO (&gexceptfds
);
493 while ((t
= coop_qget (&coop_tmp_queue
)) != NULL
)
496 coop_qput (&coop_global_sleepq
, t
);
501 while ((t
= coop_qget (&coop_tmp_queue
)) != NULL
)
502 coop_qput (&coop_global_sleepq
, t
);
506 return coop_qget (&coop_global_runq
);
509 /* Return next runnable thread on the run queue.
510 * First update the queue with possible I/O or timeouts.
511 * If no thread is found, return NULL.
514 coop_next_runnable_thread ()
520 /* Just return next thread on the runq if the sleepq is empty. */
521 if (QEMPTYP (coop_global_sleepq
))
523 if (QEMPTYP (coop_global_runq
))
524 return coop_global_curr
;
526 return coop_qget (&coop_global_runq
);
530 n
= safe_select (gnfds
, &greadfds
, &gwritefds
, &gexceptfds
, &timeout0
);
533 if (QFIRST (coop_global_sleepq
)->timeoutp
)
535 gettimeofday (&now
, NULL
);
536 t
= find_thread (n
, &now
, 0);
539 t
= find_thread (n
, 0, 0);
540 return t
== NULL
? coop_global_curr
: t
;
544 coop_wait_for_runnable_thread_now (struct timeval
*now
)
550 n
= safe_select (gnfds
, &greadfds
, &gwritefds
, &gexceptfds
, &timeout0
);
553 /* Is there any other runnable thread? */
554 t
= find_thread (n
, now
, 1);
557 /* No. Let the process go to sleep. */
558 if ((t
= QFIRST (coop_global_sleepq
))->timeoutp
)
560 now
->tv_sec
= t
->wakeup_time
.tv_sec
- now
->tv_sec
;
561 if (now
->tv_usec
> t
->wakeup_time
.tv_usec
)
564 now
->tv_usec
= 1000000 + t
->wakeup_time
.tv_usec
- now
->tv_usec
;
567 now
->tv_usec
= t
->wakeup_time
.tv_usec
- now
->tv_usec
;
568 n
= safe_select (gnfds
, &greadfds
, &gwritefds
, &gexceptfds
, now
);
571 n
= safe_select (gnfds
, &greadfds
, &gwritefds
, &gexceptfds
, NULL
);
572 gettimeofday (now
, NULL
);
573 t
= find_thread (n
, now
, 1);
580 coop_wait_for_runnable_thread ()
584 if (QEMPTYP (coop_global_sleepq
))
586 if (QEMPTYP (coop_global_runq
))
587 return coop_global_curr
;
589 return coop_qget (&coop_global_runq
);
592 if (QFIRST (coop_global_sleepq
)->timeoutp
)
593 gettimeofday (&now
, NULL
);
595 return coop_wait_for_runnable_thread_now (&now
);
598 /* Initialize bit counting array */
599 static void init_bc (int bit
, int i
, int n
)
605 init_bc (bit
>> 1, i
, n
);
606 init_bc (bit
>> 1, i
| bit
, n
+ 1);
613 #if 0 /* This is just symbolic */
617 FD_ZERO (&gwritefds
);
618 FD_ZERO (&gexceptfds
);
620 timeout0
.tv_usec
= 0;
622 init_bc (0x80, 0, 0);
626 #endif /* GUILE_ISELECT */
629 scm_internal_select (int nfds
,
630 SELECT_TYPE
*readfds
,
631 SELECT_TYPE
*writefds
,
632 SELECT_TYPE
*exceptfds
,
633 struct timeval
*timeout
)
635 #ifndef GUILE_ISELECT
636 int res
= select (nfds
, readfds
, writefds
, exceptfds
, timeout
);
639 #else /* GUILE_ISELECT */
641 coop_t
*t
, *curr
= coop_global_curr
;
643 /* If the timeout is 0, we're polling and can handle it quickly. */
645 && timeout
->tv_sec
== 0
646 && timeout
->tv_usec
== 0)
647 return select (nfds
, readfds
, writefds
, exceptfds
, timeout
);
651 /* Add our file descriptor flags to the common set. */
653 curr
->readfds
= readfds
;
654 curr
->writefds
= writefds
;
655 curr
->exceptfds
= exceptfds
;
658 /* Place ourselves on the sleep queue and get a new thread to run. */
662 coop_qput (&coop_global_sleepq
, curr
);
663 t
= coop_wait_for_runnable_thread ();
667 gettimeofday (&now
, NULL
);
669 curr
->wakeup_time
.tv_sec
= now
.tv_sec
+ timeout
->tv_sec
;
670 curr
->wakeup_time
.tv_usec
= now
.tv_usec
+ timeout
->tv_usec
;
671 if (curr
->wakeup_time
.tv_usec
>= 1000000)
673 ++curr
->wakeup_time
.tv_sec
;
674 curr
->wakeup_time
.tv_usec
-= 1000000;
676 /* Insert the current thread at the right place in the sleep queue */
677 coop_timeout_qinsert (&coop_global_sleepq
, curr
);
678 t
= coop_wait_for_runnable_thread_now (&now
);
681 /* If the new thread is the same as the sleeping thread, do nothing */
682 if (t
!= coop_global_curr
)
684 /* Do a context switch. */
685 coop_global_curr
= t
;
686 QT_BLOCK (coop_sleephelp
, curr
, NULL
, t
->sp
);
689 if (coop_global_curr
->retval
== -1)
690 errno
= coop_global_curr
->_errno
;
693 return coop_global_curr
->retval
;
694 #endif /* GUILE_ISELECT */