diff --git a/libguile/iselect.c b/libguile/iselect.c index f57f9c40f..e69de29bb 100644 --- a/libguile/iselect.c +++ b/libguile/iselect.c @@ -1,718 +0,0 @@ -/* Copyright (C) 1997, 1998, 2000, 2001, 2002 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, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 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. */ - -#include -#include -#include -#include - -#include "libguile/_scm.h" - -#ifdef HAVE_UNISTD_H -#include -#endif - -#include "libguile/async.h" - -#include "libguile/iselect.h" - -#ifdef USE_COOP_THREADS - -#include "libguile/coop-threads.h" - - - -/* COOP queue macros */ -#define QEMPTYP(q) (q.t.next == &q.t) -#define QFIRST(q) (q.t.next) - -/* These macros count the number of bits in a word. */ -#define SCM_BITS_PER_LONG (8 * sizeof (unsigned long)) -/* Use LONG_MAX instead of ULONG_MAX here since not all systems define - ULONG_MAX */ -#if LONG_MAX >> 16 == 0 -#define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\ - + bc[((unsigned char *)(p))[1]]) -#elif LONG_MAX >> 32 == 0 || LONG_MAX == 2147483647L /* bug in Sun CC 4.2 */ -#define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\ - + bc[((unsigned char *)(p))[1]]\ - + bc[((unsigned char *)(p))[2]]\ - + bc[((unsigned char *)(p))[3]]) -#elif LONG_MAX >> 64 == 0 -#define SCM_NLONGBITS(p) (bc[((unsigned char *)(p))[0]]\ - + bc[((unsigned char *)(p))[1]]\ - + bc[((unsigned char *)(p))[2]]\ - + bc[((unsigned char *)(p))[3]]\ - + bc[((unsigned char *)(p))[4]]\ - + bc[((unsigned char *)(p))[5]]\ - + bc[((unsigned char *)(p))[6]]\ - + bc[((unsigned char *)(p))[7]]) -#else -#error Could not determine suitable definition for SCM_NLONGBITS -#endif - -#define FD_ZERO_N(pos, n) memset ((void *) (pos), 0, (n)) - -typedef unsigned long *ulongptr; - -static char bc[256]; /* Bit counting array. bc[x] is the number of - bits in x. */ - -int scm_I_am_dead; - -/* This flag indicates that several threads are waiting on the same - file descriptor. When this is the case, the common fd sets are - updated in a more inefficient way. */ -static int collisionp; - -/* These are the common fd sets. When new select calls are made, - those sets are merged into these. */ -static int gnfds; -static SELECT_TYPE greadfds; -static SELECT_TYPE gwritefds; -static SELECT_TYPE gexceptfds; - -/* These are the result sets. They are used when we call OS select. - We couldn't use the common fd sets above, since that would destroy - them. */ -static SELECT_TYPE rreadfds; -static SELECT_TYPE rwritefds; -static SELECT_TYPE rexceptfds; - -/* Constant timeval struct representing a zero timeout which we use - when polling. */ -static struct timeval timeout0; - -/* As select, but doesn't destroy the file descriptor sets passed as - arguments. The results are stored into the result sets. */ -static int -safe_select (int nfds, - SELECT_TYPE *readfds, - SELECT_TYPE *writefds, - SELECT_TYPE *exceptfds, - struct timeval *timeout) -{ - int n = (nfds + 7) / 8; - /* Copy file descriptor sets to result area */ - if (readfds == NULL) - FD_ZERO (&rreadfds); - else - { - memcpy (&rreadfds, readfds, n); - FD_ZERO_N ((char *) &rreadfds + n, SELECT_SET_SIZE / 8 - n); - } - if (writefds == NULL) - FD_ZERO (&rwritefds); - else - { - memcpy (&rwritefds, writefds, n); - FD_ZERO_N ((char *) &rwritefds + n, SELECT_SET_SIZE / 8 - n); - } - if (exceptfds == NULL) - FD_ZERO (&rexceptfds); - else - { - memcpy (&rexceptfds, exceptfds, n); - FD_ZERO_N ((char *) &rexceptfds + n, SELECT_SET_SIZE / 8 - n); - } - return select (nfds, &rreadfds, &rwritefds, &rexceptfds, timeout); -} - -/* Merge new file descriptor sets into the common sets. */ -static void -add_fd_sets (coop_t *t) -{ - int n = (t->nfds + SCM_BITS_PER_LONG - 1) / SCM_BITS_PER_LONG; - int i; - - /* Detect if the fd sets of the thread have any bits in common with - the rest of the waiting threads. If that is so, set the - collision flag. This causes a more time consuming handling of - the common fd sets---they need to recalculated every time a - thread wakes up. */ - if (!collisionp) - for (i = 0; i < n; ++i) - if ((t->readfds != NULL - && (((ulongptr) t->readfds)[i] & ((ulongptr) &greadfds)[i]) != 0) - || (t->writefds != NULL - && ((((ulongptr) t->writefds)[i] & ((ulongptr) &gwritefds)[i]) - != 0)) - || (t->exceptfds != NULL - && ((((ulongptr) t->exceptfds)[i] & ((ulongptr) &gexceptfds)[i]) - != 0))) - { - collisionp = 1; - break; - } - - /* We recalculate nfds below. The cost for this can be paid back - with a great bonus since many programs are lazy with the nfds - arg. Many even pass 1024 when using one of the lowest fd:s! - - We approach from above, checking for non-zero bits. As soon as - we have determined the value of nfds, we jump down to code below - which concludes the updating of the common sets. */ - t->nfds = 0; - i = n; - while (i > 0) - { - --i; - if (t->readfds != NULL && ((ulongptr) t->readfds)[i] != 0) - { - ((ulongptr) &greadfds)[i] |= ((ulongptr) t->readfds)[i]; - n = (i + 1) * SCM_BITS_PER_LONG; - t->nfds = n; - if (n > gnfds) - gnfds = n; - goto cont_read; - } - if (t->writefds != NULL && ((ulongptr) t->writefds)[i] != 0) - { - ((ulongptr) &gwritefds)[i] |= ((ulongptr) t->writefds)[i]; - n = (i + 1) * SCM_BITS_PER_LONG; - t->nfds = n; - if (n > gnfds) - gnfds = n; - goto cont_write; - } - if (t->exceptfds != NULL && ((ulongptr) t->exceptfds)[i] != 0) - { - ((ulongptr) &gexceptfds)[i] |= ((ulongptr) t->exceptfds)[i]; - n = (i + 1) * SCM_BITS_PER_LONG; - t->nfds = n; - if (n > gnfds) - gnfds = n; - goto cont_except; - } - } - return; - - /* nfds is now determined. Just finish updating the common sets. */ - while (i > 0) - { - --i; - if (t->readfds != NULL && ((ulongptr) t->readfds)[i] != 0) - ((ulongptr) &greadfds)[i] |= ((ulongptr) t->readfds)[i]; - cont_read: - if (t->writefds != NULL && ((ulongptr) t->writefds)[i] != 0) - ((ulongptr) &gwritefds)[i] |= ((ulongptr) t->writefds)[i]; - cont_write: - if (t->exceptfds != NULL && ((ulongptr) t->exceptfds)[i] != 0) - ((ulongptr) &gexceptfds)[i] |= ((ulongptr) t->exceptfds)[i]; - cont_except: - ; - } -} - -/* Update the fd sets pointed to by the thread so that they reflect - the status of the file descriptors which the thread was interested - in. Also clear those bits in the common sets. This function is - only called when there are no bit collisions. */ -static void -finalize_fd_sets (coop_t *t) -{ - int i = (t->nfds + SCM_BITS_PER_LONG - 1) / SCM_BITS_PER_LONG; - int n_ones = 0; - register unsigned long s; - - if (t->nfds == gnfds) - { - /* This thread is the one responsible for the current high value - of gnfds. First do our other jobs while at the same time - trying to decrease gnfds. */ - while (i > 0) - { - --i; - if (t->readfds != NULL && (s = ((ulongptr) t->readfds)[i]) != 0) - { - ((ulongptr) t->readfds)[i] &= ((ulongptr) &rreadfds)[i]; - ((ulongptr) &greadfds)[i] &= ~s; - n_ones += SCM_NLONGBITS (&((ulongptr) t->readfds)[i]); - } - if (((ulongptr) &greadfds)[i] != 0) - { - gnfds = (i + 1) * SCM_BITS_PER_LONG; - goto cont_read; - } - if (t->writefds != NULL && (s = ((ulongptr) t->writefds)[i]) != 0) - { - ((ulongptr) t->writefds)[i] &= ((ulongptr) &rwritefds)[i]; - ((ulongptr) &gwritefds)[i] &= ~s; - n_ones += SCM_NLONGBITS (&((ulongptr) t->writefds)[i]); - } - if (((ulongptr) &gwritefds)[i] != 0) - { - gnfds = (i + 1) * SCM_BITS_PER_LONG; - goto cont_write; - } - if (t->exceptfds != NULL && (s = ((ulongptr) t->exceptfds)[i]) != 0) - { - ((ulongptr) t->exceptfds)[i] &= ((ulongptr) &rexceptfds)[i]; - ((ulongptr) &gexceptfds)[i] &= ~s; - n_ones += SCM_NLONGBITS (&((ulongptr) t->exceptfds)[i]); - } - if (((ulongptr) &gexceptfds)[i] != 0) - { - gnfds = (i + 1) * SCM_BITS_PER_LONG; - goto cont_except; - } - } - gnfds = 0; - t->retval = n_ones; - return; - } - - /* Either this thread wasn't responsible for gnfds or gnfds has been - determined. */ - while (i > 0) - { - --i; - if (t->readfds != NULL && (s = ((ulongptr) t->readfds)[i]) != 0) - { - ((ulongptr) t->readfds)[i] &= ((ulongptr) &rreadfds)[i]; - ((ulongptr) &greadfds)[i] &= ~s; - n_ones += SCM_NLONGBITS (&((ulongptr) t->readfds)[i]); - } - cont_read: - if (t->writefds != NULL && (s = ((ulongptr) t->writefds)[i]) != 0) - { - ((ulongptr) t->writefds)[i] &= ((ulongptr) &rwritefds)[i]; - ((ulongptr) &gwritefds)[i] &= ~s; - n_ones += SCM_NLONGBITS (&((ulongptr) t->writefds)[i]); - } - cont_write: - if (t->exceptfds != NULL && (s = ((ulongptr) t->exceptfds)[i]) != 0) - { - ((ulongptr) t->exceptfds)[i] &= ((ulongptr) &rexceptfds)[i]; - ((ulongptr) &gexceptfds)[i] &= ~s; - n_ones += SCM_NLONGBITS (&((ulongptr) t->exceptfds)[i]); - } - cont_except: - ; - } - t->retval = n_ones; -} - -/* Just like finalize_fd_sets except that we don't have to update the - global fd sets. Those will be recalulated elsewhere. */ -static void -finalize_fd_sets_lazily (coop_t *t) -{ - int i = (t->nfds + SCM_BITS_PER_LONG - 1) / SCM_BITS_PER_LONG; - int n_ones = 0; - while (i > 0) - { - --i; - if (t->readfds != NULL && ((ulongptr) t->readfds)[i] != 0) - { - ((ulongptr) t->readfds)[i] &= ((ulongptr) &rreadfds)[i]; - n_ones += SCM_NLONGBITS (&((ulongptr) t->readfds)[i]); - } - if (t->writefds != NULL && ((ulongptr) t->writefds)[i] != 0) - { - ((ulongptr) t->writefds)[i] &= ((ulongptr) &rwritefds)[i]; - n_ones += SCM_NLONGBITS (&((ulongptr) t->writefds)[i]); - } - if (t->exceptfds != NULL && ((ulongptr) t->exceptfds)[i] != 0) - { - ((ulongptr) t->exceptfds)[i] &= ((ulongptr) &rexceptfds)[i]; - n_ones += SCM_NLONGBITS (&((ulongptr) t->exceptfds)[i]); - } - } - t->retval = n_ones; -} - -/* Return first fd with a non-zero bit in any of the result sets. */ -static int -first_interesting_fd (void) -{ - int i = 0; - SELECT_TYPE *s; - while (1) - { - if (((ulongptr) &rreadfds)[i] != 0) - { - s = &rreadfds; - break; - } - if (((ulongptr) &rwritefds)[i] != 0) - { - s = &rwritefds; - break; - } - if (((ulongptr) &rexceptfds)[i] != 0) - { - s = &rexceptfds; - break; - } - ++i; - } - i *= SCM_BITS_PER_LONG; - while (i < gnfds) - { - if (FD_ISSET (i, s)) - return i; - ++i; - } - fprintf (stderr, "first_interesting_fd: internal error\n"); - exit (1); -} - -/* Revive all threads with an error status. */ -void -scm_error_revive_threads (void) -{ - coop_t *t; - - while ((t = coop_qget (&coop_global_sleepq)) != NULL) - { - t->_errno = errno; - t->retval = -1; - if (t != coop_global_curr) - coop_qput (&coop_global_runq, t); - } - collisionp = 0; - gnfds = 0; - FD_ZERO (&greadfds); - FD_ZERO (&gwritefds); - FD_ZERO (&gexceptfds); -} - -/* Given the result of a call to safe_select and the current time, - try to wake up some threads and return the first one. Return NULL - if we couldn't find any. */ -static coop_t * -find_thread (int n, struct timeval *now, int sleepingp) -{ - coop_t *t; - int fd; - - if (n < 0) - /* An error or a signal has occured. Wake all threads. Since we - don't care to calculate if there is a sinner we report the - error to all of them. */ - { - scm_error_revive_threads (); - if (!scm_I_am_dead) - return coop_global_curr; - } - else if (n == 0) - { - while (!QEMPTYP (coop_global_sleepq) - && (t = QFIRST (coop_global_sleepq))->timeoutp - && (t->wakeup_time.tv_sec < now->tv_sec - || (t->wakeup_time.tv_sec == now->tv_sec - && t->wakeup_time.tv_usec <= now->tv_usec))) - { - coop_qget (&coop_global_sleepq); - if (collisionp) - finalize_fd_sets_lazily (t); - else - finalize_fd_sets (t); - coop_qput (&coop_global_runq, t); - } - if (collisionp) - { - while ((t = coop_qget (&coop_global_sleepq)) != NULL) - coop_qput (&coop_tmp_queue, t); - goto rebuild_global_fd_sets; - } - } - else if (n > 0) - { - /* Find the first interesting file descriptor */ - fd = first_interesting_fd (); - /* Check the sleeping queue for this file descriptor. - Other file descriptors will be handled next time - coop_next_runnable_thread is called. */ - /* This code is inefficient. We'll improve it later. */ - while ((t = coop_qget (&coop_global_sleepq)) != NULL) - { - if ((t->readfds && FD_ISSET (fd, t->readfds)) - || (t->writefds && FD_ISSET (fd, t->writefds)) - || (t->exceptfds && FD_ISSET (fd, t->exceptfds)) - || (t->timeoutp - && (t->wakeup_time.tv_sec < now->tv_sec - || (t->wakeup_time.tv_sec == now->tv_sec - && t->wakeup_time.tv_usec <= now->tv_usec)))) - { - if (collisionp) - finalize_fd_sets_lazily (t); - else - finalize_fd_sets (t); - coop_qput (&coop_global_runq, t); - } - else - coop_qput(&coop_tmp_queue, t); - } - if (collisionp) - { - rebuild_global_fd_sets: - collisionp = 0; - gnfds = 0; - FD_ZERO (&greadfds); - FD_ZERO (&gwritefds); - FD_ZERO (&gexceptfds); - while ((t = coop_qget (&coop_tmp_queue)) != NULL) - { - add_fd_sets (t); - coop_qput (&coop_global_sleepq, t); - } - } - else - { - while ((t = coop_qget (&coop_tmp_queue)) != NULL) - coop_qput (&coop_global_sleepq, t); - } - } - - return coop_qget (&coop_global_runq); -} - -/* Return next runnable thread on the run queue. - * First update the queue with possible I/O or timeouts. - * If no thread is found, return NULL. - */ -coop_t * -coop_next_runnable_thread () -{ - coop_t *t; - struct timeval now; - int n; - - /* Just return next thread on the runq if the sleepq is empty. */ - if (QEMPTYP (coop_global_sleepq)) - { - if (QEMPTYP (coop_global_runq)) - return coop_global_curr; - else - return coop_qget (&coop_global_runq); - } - - if (gnfds > 0) - n = safe_select (gnfds, &greadfds, &gwritefds, &gexceptfds, &timeout0); - else - n = 0; - if (QFIRST (coop_global_sleepq)->timeoutp) - { - gettimeofday (&now, NULL); - t = find_thread (n, &now, 0); - } - else - t = find_thread (n, 0, 0); - return t == NULL ? coop_global_curr : t; -} - -coop_t * -coop_wait_for_runnable_thread_now (struct timeval *now) -{ - int n; - coop_t *t; - - if (gnfds > 0) - n = safe_select (gnfds, &greadfds, &gwritefds, &gexceptfds, &timeout0); - else - n = 0; - /* Is there any other runnable thread? */ - t = find_thread (n, now, 1); - while (t == NULL) - { - /* No. Let the process go to sleep. */ - if ((t = QFIRST (coop_global_sleepq))->timeoutp) - { - now->tv_sec = t->wakeup_time.tv_sec - now->tv_sec; - if (now->tv_usec > t->wakeup_time.tv_usec) - { - --now->tv_sec; - now->tv_usec = 1000000 + t->wakeup_time.tv_usec - now->tv_usec; - } - else - now->tv_usec = t->wakeup_time.tv_usec - now->tv_usec; - n = safe_select (gnfds, &greadfds, &gwritefds, &gexceptfds, now); - } - else - n = safe_select (gnfds, &greadfds, &gwritefds, &gexceptfds, NULL); - gettimeofday (now, NULL); - t = find_thread (n, now, 1); - } - - return t; -} - -coop_t * -coop_wait_for_runnable_thread () -{ - struct timeval now; - - if (QEMPTYP (coop_global_sleepq)) - { - if (QEMPTYP (coop_global_runq)) - return coop_global_curr; - else - return coop_qget (&coop_global_runq); - } - - if (QFIRST (coop_global_sleepq)->timeoutp) - gettimeofday (&now, NULL); - - return coop_wait_for_runnable_thread_now (&now); -} - -/* Initialize bit counting array */ -static void init_bc (int bit, int i, int n) -{ - if (bit == 0) - bc[i] = n; - else - { - init_bc (bit >> 1, i, n); - init_bc (bit >> 1, i | bit, n + 1); - } -} - -void -scm_init_iselect () -{ -#if 0 /* This is just symbolic */ - collisionp = 0; - gnfds = 0; - FD_ZERO (&greadfds); - FD_ZERO (&gwritefds); - FD_ZERO (&gexceptfds); - timeout0.tv_sec = 0; - timeout0.tv_usec = 0; -#endif - init_bc (0x80, 0, 0); -#include "libguile/iselect.x" -} - -int -scm_internal_select (int nfds, - SELECT_TYPE *readfds, - SELECT_TYPE *writefds, - SELECT_TYPE *exceptfds, - struct timeval *timeout) -{ - struct timeval now; - coop_t *t, *curr = coop_global_curr; - - /* If the timeout is 0, we're polling and can handle it quickly. */ - if (timeout != NULL - && timeout->tv_sec == 0 - && timeout->tv_usec == 0) - return select (nfds, readfds, writefds, exceptfds, timeout); - - SCM_DEFER_INTS; - - /* Add our file descriptor flags to the common set. */ - curr->nfds = nfds; - curr->readfds = readfds; - curr->writefds = writefds; - curr->exceptfds = exceptfds; - add_fd_sets (curr); - - /* Place ourselves on the sleep queue and get a new thread to run. */ - if (timeout == NULL) - { - curr->timeoutp = 0; - coop_qput (&coop_global_sleepq, curr); - t = coop_wait_for_runnable_thread (); - } - else - { - gettimeofday (&now, NULL); - curr->timeoutp = 1; - curr->wakeup_time.tv_sec = now.tv_sec + timeout->tv_sec; - curr->wakeup_time.tv_usec = now.tv_usec + timeout->tv_usec; - if (curr->wakeup_time.tv_usec >= 1000000) - { - ++curr->wakeup_time.tv_sec; - curr->wakeup_time.tv_usec -= 1000000; - } - /* Insert the current thread at the right place in the sleep queue */ - coop_timeout_qinsert (&coop_global_sleepq, curr); - t = coop_wait_for_runnable_thread_now (&now); - } - - /* If the new thread is the same as the sleeping thread, do nothing */ - if (t != coop_global_curr) - { - /* Do a context switch. */ - coop_global_curr = t; - QT_BLOCK (coop_sleephelp, curr, NULL, t->sp); - } - - if (coop_global_curr->retval == -1) - errno = coop_global_curr->_errno; - SCM_ALLOW_INTS; - SCM_ASYNC_TICK; - return coop_global_curr->retval; -} - -#else -#ifdef USE_NULL_THREADS - -int -scm_internal_select (int nfds, - SELECT_TYPE *readfds, - SELECT_TYPE *writefds, - SELECT_TYPE *exceptfds, - struct timeval *timeout) -{ - int res = select (nfds, readfds, writefds, exceptfds, timeout); - SCM_ASYNC_TICK; - return res; -} - -void -scm_init_iselect () -{ -#include "libguile/iselect.x" -} - -#endif /* USE_NULL_THREADS */ -#endif /* !USE_COOP_THREADS */ - -/* - Local Variables: - c-file-style: "gnu" - End: -*/