d18213c4cb581b1ea7721c8deab3d3a4f7c77749
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. */
50 #include "libguile/_scm.h"
51 #include "libguile/async.h"
53 #include "libguile/iselect.h"
57 #include "libguile/coop-threads.h"
59 #ifdef MISSING_BZERO_DECL
60 extern void bzero (void *, size_t);
65 /* COOP queue macros */
66 #define QEMPTYP(q) (q.t.next == &q.t)
67 #define QFIRST(q) (q.t.next)
69 /* These macros count the number of bits in a word. */
70 #define SCM_BITS_PER_LONG (8 * sizeof (unsigned long))
71 /* Use LONG_MAX instead of ULONG_MAX here since not all systems define
73 #if LONG_MAX >> 16 == 0
74 #define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\
75 + bc[((unsigned char *)(p))[1]])
76 #elif LONG_MAX >> 32 == 0 || LONG_MAX == 2147483647L /* bug in Sun CC 4.2 */
77 #define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\
78 + bc[((unsigned char *)(p))[1]]\
79 + bc[((unsigned char *)(p))[2]]\
80 + bc[((unsigned char *)(p))[3]])
81 #elif LONG_MAX >> 64 == 0
82 #define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\
83 + bc[((unsigned char *)(p))[1]]\
84 + bc[((unsigned char *)(p))[2]]\
85 + bc[((unsigned char *)(p))[3]]\
86 + bc[((unsigned char *)(p))[4]]\
87 + bc[((unsigned char *)(p))[5]]\
88 + bc[((unsigned char *)(p))[6]]\
89 + bc[((unsigned char *)(p))[7]])
91 #error Could not determine suitable definition for SCM_NLONGBITS
95 #define FD_ZERO_N(pos, n) bzero ((pos), (n))
97 #define FD_ZERO_N(pos, n) memset ((void *) (pos), 0, (n))
100 typedef unsigned long *ulongptr
;
102 static char bc
[256]; /* Bit counting array. bc[x] is the number of
107 /* This flag indicates that several threads are waiting on the same
108 file descriptor. When this is the case, the common fd sets are
109 updated in a more inefficient way. */
112 /* These are the common fd sets. When new select calls are made,
113 those sets are merged into these. */
115 SELECT_TYPE greadfds
;
116 SELECT_TYPE gwritefds
;
117 SELECT_TYPE gexceptfds
;
119 /* These are the result sets. They are used when we call OS select.
120 We couldn't use the common fd sets above, since that would destroy
122 SELECT_TYPE rreadfds
;
123 SELECT_TYPE rwritefds
;
124 SELECT_TYPE rexceptfds
;
126 /* Constant timeval struct representing a zero timeout which we use
128 static struct timeval timeout0
;
130 /* As select, but doesn't destroy the file descriptor sets passed as
131 arguments. The results are stored into the result sets. */
133 safe_select (int nfds
,
134 SELECT_TYPE
*readfds
,
135 SELECT_TYPE
*writefds
,
136 SELECT_TYPE
*exceptfds
,
137 struct timeval
*timeout
)
139 int n
= (nfds
+ 7) / 8;
140 /* Copy file descriptor sets to result area */
145 memcpy (&rreadfds
, readfds
, n
);
146 FD_ZERO_N ((char *) &rreadfds
+ n
, SELECT_SET_SIZE
/ 8 - n
);
148 if (writefds
== NULL
)
149 FD_ZERO (&rwritefds
);
152 memcpy (&rwritefds
, writefds
, n
);
153 FD_ZERO_N ((char *) &rwritefds
+ n
, SELECT_SET_SIZE
/ 8 - n
);
155 if (exceptfds
== NULL
)
156 FD_ZERO (&rexceptfds
);
159 memcpy (&rexceptfds
, exceptfds
, n
);
160 FD_ZERO_N ((char *) &rexceptfds
+ n
, SELECT_SET_SIZE
/ 8 - n
);
162 return select (nfds
, &rreadfds
, &rwritefds
, &rexceptfds
, timeout
);
165 /* Merge new file descriptor sets into the common sets. */
167 add_fd_sets (coop_t
*t
)
169 int n
= (t
->nfds
+ SCM_BITS_PER_LONG
- 1) / SCM_BITS_PER_LONG
;
172 /* Detect if the fd sets of the thread have any bits in common with
173 the rest of the waiting threads. If that is so, set the
174 collision flag. This causes a more time consuming handling of
175 the common fd sets---they need to recalculated every time a
178 for (i
= 0; i
< n
; ++i
)
179 if ((t
->readfds
!= NULL
180 && (((ulongptr
) t
->readfds
)[i
] & ((ulongptr
) &greadfds
)[i
]) != 0)
181 || (t
->writefds
!= NULL
182 && ((((ulongptr
) t
->writefds
)[i
] & ((ulongptr
) &gwritefds
)[i
])
184 || (t
->exceptfds
!= NULL
185 && ((((ulongptr
) t
->exceptfds
)[i
] & ((ulongptr
) &gexceptfds
)[i
])
192 /* We recalculate nfds below. The cost for this can be paid back
193 with a great bonus since many programs are lazy with the nfds
194 arg. Many even pass 1024 when using one of the lowest fd:s!
196 We approach from above, checking for non-zero bits. As soon as
197 we have determined the value of nfds, we jump down to code below
198 which concludes the updating of the common sets. */
204 if (t
->readfds
!= NULL
&& ((ulongptr
) t
->readfds
)[i
] != 0)
206 ((ulongptr
) &greadfds
)[i
] |= ((ulongptr
) t
->readfds
)[i
];
207 n
= (i
+ 1) * SCM_BITS_PER_LONG
;
213 if (t
->writefds
!= NULL
&& ((ulongptr
) t
->writefds
)[i
] != 0)
215 ((ulongptr
) &gwritefds
)[i
] |= ((ulongptr
) t
->writefds
)[i
];
216 n
= (i
+ 1) * SCM_BITS_PER_LONG
;
222 if (t
->exceptfds
!= NULL
&& ((ulongptr
) t
->exceptfds
)[i
] != 0)
224 ((ulongptr
) &gexceptfds
)[i
] |= ((ulongptr
) t
->exceptfds
)[i
];
225 n
= (i
+ 1) * SCM_BITS_PER_LONG
;
234 /* nfds is now determined. Just finish updating the common sets. */
238 if (t
->readfds
!= NULL
&& ((ulongptr
) t
->readfds
)[i
] != 0)
239 ((ulongptr
) &greadfds
)[i
] |= ((ulongptr
) t
->readfds
)[i
];
241 if (t
->writefds
!= NULL
&& ((ulongptr
) t
->writefds
)[i
] != 0)
242 ((ulongptr
) &gwritefds
)[i
] |= ((ulongptr
) t
->writefds
)[i
];
244 if (t
->exceptfds
!= NULL
&& ((ulongptr
) t
->exceptfds
)[i
] != 0)
245 ((ulongptr
) &gexceptfds
)[i
] |= ((ulongptr
) t
->exceptfds
)[i
];
251 /* Update the fd sets pointed to by the thread so that they reflect
252 the status of the file descriptors which the thread was interested
253 in. Also clear those bits in the common sets. This function is
254 only called when there are no bit collisions. */
256 finalize_fd_sets (coop_t
*t
)
258 int i
= (t
->nfds
+ SCM_BITS_PER_LONG
- 1) / SCM_BITS_PER_LONG
;
260 register unsigned long s
;
262 if (t
->nfds
== gnfds
)
264 /* This thread is the one responsible for the current high value
265 of gnfds. First do our other jobs while at the same time
266 trying to decrease gnfds. */
270 if (t
->readfds
!= NULL
&& (s
= ((ulongptr
) t
->readfds
)[i
]) != 0)
272 ((ulongptr
) t
->readfds
)[i
] &= ((ulongptr
) &rreadfds
)[i
];
273 ((ulongptr
) &greadfds
)[i
] &= ~s
;
274 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->readfds
)[i
]);
276 if (((ulongptr
) &greadfds
)[i
] != 0)
278 gnfds
= (i
+ 1) * SCM_BITS_PER_LONG
;
281 if (t
->writefds
!= NULL
&& (s
= ((ulongptr
) t
->writefds
)[i
]) != 0)
283 ((ulongptr
) t
->writefds
)[i
] &= ((ulongptr
) &rwritefds
)[i
];
284 ((ulongptr
) &gwritefds
)[i
] &= ~s
;
285 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->writefds
)[i
]);
287 if (((ulongptr
) &gwritefds
)[i
] != 0)
289 gnfds
= (i
+ 1) * SCM_BITS_PER_LONG
;
292 if (t
->exceptfds
!= NULL
&& (s
= ((ulongptr
) t
->exceptfds
)[i
]) != 0)
294 ((ulongptr
) t
->exceptfds
)[i
] &= ((ulongptr
) &rexceptfds
)[i
];
295 ((ulongptr
) &gexceptfds
)[i
] &= ~s
;
296 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->exceptfds
)[i
]);
298 if (((ulongptr
) &gexceptfds
)[i
] != 0)
300 gnfds
= (i
+ 1) * SCM_BITS_PER_LONG
;
309 /* Either this thread wasn't responsible for gnfds or gnfds has been
314 if (t
->readfds
!= NULL
&& (s
= ((ulongptr
) t
->readfds
)[i
]) != 0)
316 ((ulongptr
) t
->readfds
)[i
] &= ((ulongptr
) &rreadfds
)[i
];
317 ((ulongptr
) &greadfds
)[i
] &= ~s
;
318 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->readfds
)[i
]);
321 if (t
->writefds
!= NULL
&& (s
= ((ulongptr
) t
->writefds
)[i
]) != 0)
323 ((ulongptr
) t
->writefds
)[i
] &= ((ulongptr
) &rwritefds
)[i
];
324 ((ulongptr
) &gwritefds
)[i
] &= ~s
;
325 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->writefds
)[i
]);
328 if (t
->exceptfds
!= NULL
&& (s
= ((ulongptr
) t
->exceptfds
)[i
]) != 0)
330 ((ulongptr
) t
->exceptfds
)[i
] &= ((ulongptr
) &rexceptfds
)[i
];
331 ((ulongptr
) &gexceptfds
)[i
] &= ~s
;
332 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->exceptfds
)[i
]);
340 /* Just like finalize_fd_sets except that we don't have to update the
341 global fd sets. Those will be recalulated elsewhere. */
343 finalize_fd_sets_lazily (coop_t
*t
)
345 int i
= (t
->nfds
+ SCM_BITS_PER_LONG
- 1) / SCM_BITS_PER_LONG
;
350 if (t
->readfds
!= NULL
&& ((ulongptr
) t
->readfds
)[i
] != 0)
352 ((ulongptr
) t
->readfds
)[i
] &= ((ulongptr
) &rreadfds
)[i
];
353 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->readfds
)[i
]);
355 if (t
->writefds
!= NULL
&& ((ulongptr
) t
->writefds
)[i
] != 0)
357 ((ulongptr
) t
->writefds
)[i
] &= ((ulongptr
) &rwritefds
)[i
];
358 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->writefds
)[i
]);
360 if (t
->exceptfds
!= NULL
&& ((ulongptr
) t
->exceptfds
)[i
] != 0)
362 ((ulongptr
) t
->exceptfds
)[i
] &= ((ulongptr
) &rexceptfds
)[i
];
363 n_ones
+= SCM_NLONGBITS (&((ulongptr
) t
->exceptfds
)[i
]);
369 /* Return first fd with a non-zero bit in any of the result sets. */
371 first_interesting_fd (void)
377 if (((ulongptr
) &rreadfds
)[i
] != 0)
382 if (((ulongptr
) &rwritefds
)[i
] != 0)
387 if (((ulongptr
) &rexceptfds
)[i
] != 0)
394 i
*= SCM_BITS_PER_LONG
;
401 fprintf (stderr
, "first_interesting_fd: internal error\n");
405 /* Revive all threads with an error status. */
407 scm_error_revive_threads (void)
411 while ((t
= coop_qget (&coop_global_sleepq
)) != NULL
)
415 if (t
!= coop_global_curr
)
416 coop_qput (&coop_global_runq
, t
);
421 FD_ZERO (&gwritefds
);
422 FD_ZERO (&gexceptfds
);
425 /* Given the result of a call to safe_select and the current time,
426 try to wake up some threads and return the first one. Return NULL
427 if we couldn't find any. */
429 find_thread (int n
, struct timeval
*now
, int sleepingp
)
435 /* An error or a signal has occured. Wake all threads. Since we
436 don't care to calculate if there is a sinner we report the
437 error to all of them. */
439 scm_error_revive_threads ();
441 return coop_global_curr
;
445 while (!QEMPTYP (coop_global_sleepq
)
446 && (t
= QFIRST (coop_global_sleepq
))->timeoutp
447 && (t
->wakeup_time
.tv_sec
< now
->tv_sec
448 || (t
->wakeup_time
.tv_sec
== now
->tv_sec
449 && t
->wakeup_time
.tv_usec
<= now
->tv_usec
)))
451 coop_qget (&coop_global_sleepq
);
453 finalize_fd_sets_lazily (t
);
455 finalize_fd_sets (t
);
456 coop_qput (&coop_global_runq
, t
);
460 while ((t
= coop_qget (&coop_global_sleepq
)) != NULL
)
461 coop_qput (&coop_tmp_queue
, t
);
462 goto rebuild_global_fd_sets
;
467 /* Find the first interesting file descriptor */
468 fd
= first_interesting_fd ();
469 /* Check the sleeping queue for this file descriptor.
470 Other file descriptors will be handled next time
471 coop_next_runnable_thread is called. */
472 /* This code is inefficient. We'll improve it later. */
473 while ((t
= coop_qget (&coop_global_sleepq
)) != NULL
)
475 if ((t
->readfds
&& FD_ISSET (fd
, t
->readfds
))
476 || (t
->writefds
&& FD_ISSET (fd
, t
->writefds
))
477 || (t
->exceptfds
&& FD_ISSET (fd
, t
->exceptfds
))
479 && (t
->wakeup_time
.tv_sec
< now
->tv_sec
480 || (t
->wakeup_time
.tv_sec
== now
->tv_sec
481 && t
->wakeup_time
.tv_usec
<= now
->tv_usec
))))
484 finalize_fd_sets_lazily (t
);
486 finalize_fd_sets (t
);
487 coop_qput (&coop_global_runq
, t
);
490 coop_qput(&coop_tmp_queue
, t
);
494 rebuild_global_fd_sets
:
498 FD_ZERO (&gwritefds
);
499 FD_ZERO (&gexceptfds
);
500 while ((t
= coop_qget (&coop_tmp_queue
)) != NULL
)
503 coop_qput (&coop_global_sleepq
, t
);
508 while ((t
= coop_qget (&coop_tmp_queue
)) != NULL
)
509 coop_qput (&coop_global_sleepq
, t
);
513 return coop_qget (&coop_global_runq
);
516 /* Return next runnable thread on the run queue.
517 * First update the queue with possible I/O or timeouts.
518 * If no thread is found, return NULL.
521 coop_next_runnable_thread ()
527 /* Just return next thread on the runq if the sleepq is empty. */
528 if (QEMPTYP (coop_global_sleepq
))
530 if (QEMPTYP (coop_global_runq
))
531 return coop_global_curr
;
533 return coop_qget (&coop_global_runq
);
537 n
= safe_select (gnfds
, &greadfds
, &gwritefds
, &gexceptfds
, &timeout0
);
540 if (QFIRST (coop_global_sleepq
)->timeoutp
)
542 gettimeofday (&now
, NULL
);
543 t
= find_thread (n
, &now
, 0);
546 t
= find_thread (n
, 0, 0);
547 return t
== NULL
? coop_global_curr
: t
;
551 coop_wait_for_runnable_thread_now (struct timeval
*now
)
557 n
= safe_select (gnfds
, &greadfds
, &gwritefds
, &gexceptfds
, &timeout0
);
560 /* Is there any other runnable thread? */
561 t
= find_thread (n
, now
, 1);
564 /* No. Let the process go to sleep. */
565 if ((t
= QFIRST (coop_global_sleepq
))->timeoutp
)
567 now
->tv_sec
= t
->wakeup_time
.tv_sec
- now
->tv_sec
;
568 if (now
->tv_usec
> t
->wakeup_time
.tv_usec
)
571 now
->tv_usec
= 1000000 + t
->wakeup_time
.tv_usec
- now
->tv_usec
;
574 now
->tv_usec
= t
->wakeup_time
.tv_usec
- now
->tv_usec
;
575 n
= safe_select (gnfds
, &greadfds
, &gwritefds
, &gexceptfds
, now
);
578 n
= safe_select (gnfds
, &greadfds
, &gwritefds
, &gexceptfds
, NULL
);
579 gettimeofday (now
, NULL
);
580 t
= find_thread (n
, now
, 1);
587 coop_wait_for_runnable_thread ()
591 if (QEMPTYP (coop_global_sleepq
))
593 if (QEMPTYP (coop_global_runq
))
594 return coop_global_curr
;
596 return coop_qget (&coop_global_runq
);
599 if (QFIRST (coop_global_sleepq
)->timeoutp
)
600 gettimeofday (&now
, NULL
);
602 return coop_wait_for_runnable_thread_now (&now
);
605 /* Initialize bit counting array */
606 static void init_bc (int bit
, int i
, int n
)
612 init_bc (bit
>> 1, i
, n
);
613 init_bc (bit
>> 1, i
| bit
, n
+ 1);
620 #if 0 /* This is just symbolic */
624 FD_ZERO (&gwritefds
);
625 FD_ZERO (&gexceptfds
);
627 timeout0
.tv_usec
= 0;
629 init_bc (0x80, 0, 0);
630 #ifndef SCM_MAGIC_SNARFER
631 #include "libguile/iselect.x"
635 #endif /* GUILE_ISELECT */
638 scm_internal_select (int nfds
,
639 SELECT_TYPE
*readfds
,
640 SELECT_TYPE
*writefds
,
641 SELECT_TYPE
*exceptfds
,
642 struct timeval
*timeout
)
644 #ifndef GUILE_ISELECT
645 int res
= select (nfds
, readfds
, writefds
, exceptfds
, timeout
);
648 #else /* GUILE_ISELECT */
650 coop_t
*t
, *curr
= coop_global_curr
;
652 /* If the timeout is 0, we're polling and can handle it quickly. */
654 && timeout
->tv_sec
== 0
655 && timeout
->tv_usec
== 0)
656 return select (nfds
, readfds
, writefds
, exceptfds
, timeout
);
660 /* Add our file descriptor flags to the common set. */
662 curr
->readfds
= readfds
;
663 curr
->writefds
= writefds
;
664 curr
->exceptfds
= exceptfds
;
667 /* Place ourselves on the sleep queue and get a new thread to run. */
671 coop_qput (&coop_global_sleepq
, curr
);
672 t
= coop_wait_for_runnable_thread ();
676 gettimeofday (&now
, NULL
);
678 curr
->wakeup_time
.tv_sec
= now
.tv_sec
+ timeout
->tv_sec
;
679 curr
->wakeup_time
.tv_usec
= now
.tv_usec
+ timeout
->tv_usec
;
680 if (curr
->wakeup_time
.tv_usec
>= 1000000)
682 ++curr
->wakeup_time
.tv_sec
;
683 curr
->wakeup_time
.tv_usec
-= 1000000;
685 /* Insert the current thread at the right place in the sleep queue */
686 coop_timeout_qinsert (&coop_global_sleepq
, curr
);
687 t
= coop_wait_for_runnable_thread_now (&now
);
690 /* If the new thread is the same as the sleeping thread, do nothing */
691 if (t
!= coop_global_curr
)
693 /* Do a context switch. */
694 coop_global_curr
= t
;
695 QT_BLOCK (coop_sleephelp
, curr
, NULL
, t
->sp
);
698 if (coop_global_curr
->retval
== -1)
699 errno
= coop_global_curr
->_errno
;
702 return coop_global_curr
->retval
;
703 #endif /* GUILE_ISELECT */