guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] Thread Plug-in Support #1


From: NIIBE Yutaka
Subject: [PATCH] Thread Plug-in Support #1
Date: Wed, 11 Apr 2001 09:57:57 +0900 (JST)

Patch piece #1.

In this piece, functions in iselect.c are moved to coop.c, because
most of the code in iselect.c depends on COOP.  Temporarily,
scm_c_thread_select is declared in iselect.h, so that this patch piece
can apply to current code.  It will be override by another patch
piece.

The patch was made by Dirk last year, I just apply to current code and
make more verbose ChangeLog entries.

No regression with "make check".  One warning for compiling time (for
bzero) is added.  This warning will be removed by another patch piece.

libguile/ChangeLog

        Merge of Dirk's thread-plug-in support (#1).
        * init.c: Remove the inclusion of iselect.h.
        (scm_init_guile_1): Remove the initialization of iselect.

        * coop.c (scm_c_thread_select): New function.  Implementation
        taken from scm_internal_select of iselect.c.
        (collisionp, gnfds, greadfds, gwritefds, gexceptfds): Make
        them static.
        (init_iselect): Rename from scm_init_iselect. Make it static.
        (error_revive_threads): Rename from scm_error_revive_threads
        and make it static
        (I_am_dead): Rename from scm_I_am_dead and make it static.
        (coop_init): Move initialization of iselect here.

        * iselect.c (bc, scm_I_am_dead, collisionp, gnfds, greadfds,
        gwritefds, gexceptfds, rreadfds, rwritefds, rexceptfds, timeout0,
        safe_select, add_fd_sets, finalize_fd_sets,
        finalize_fd_sets_lazily, first_interesting_fd,
        scm_error_revive_threads, find_thread, coop_next_runnable_thread, 
        coop_wait_for_runnable_thread_now, coop_wait_for_runnable_thread, 
        init_bc, scm_init_iselect): Move those functions to coop.c.
        (scm_internal_select): Call scm_c_thread_select in the case of
        defined(GUILE_ISELECT).

        * iselect.h (scm_internal_select): Declare scm_c_thread_select.
        (scm_I_am_dead, scm_error_revive_threads, scm_init_iselect):
        Declaration removed.

Index: libguile/coop.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/coop.c,v
retrieving revision 1.27
diff -u -r1.27 coop.c
--- libguile/coop.c     2001/03/10 03:09:07     1.27
+++ libguile/coop.c     2001/04/11 00:40:43
@@ -62,6 +62,79 @@
 #define COOP_STKALIGN(sp, alignment) \
 ((void *)((((qt_word_t)(sp)) + (alignment) - 1) & ~((alignment)-1)))
 
+#ifdef GUILE_ISELECT
+#include "libguile/iselect.h"
+
+#ifdef MISSING_BZERO_DECL
+extern void bzero (void *, size_t);
+#endif
+
+/* 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
+
+#ifdef HAVE_BZERO
+#define FD_ZERO_N(pos, n) bzero ((pos), (n))
+#else
+#define FD_ZERO_N(pos, n) memset ((void *) (pos), 0, (n))
+#endif
+
+typedef unsigned long *ulongptr;
+
+static char bc[256]; /* Bit counting array.  bc[x] is the number of
+                       bits in x. */
+
+static int 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.  */
+SELECT_TYPE rreadfds;
+SELECT_TYPE rwritefds;
+SELECT_TYPE rexceptfds;
+
+/* Constant timeval struct representing a zero timeout which we use
+   when polling.  */
+static struct timeval timeout0;
+
+#endif
 
 
 /* Queue access functions. */
@@ -152,6 +225,36 @@
   if (t->next == &q->t)
     q->tail = t;
 }
+
+/* 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);
+    }
+}
+
+static void
+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);
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/iselect.x"
+#endif
+}
 #endif
 
 
@@ -205,6 +308,11 @@
 void
 coop_init ()
 {
+  /* Dirk:FIXME:: This is a temporary solution, in order not to change the
+   * code too much at the moment. 
+   */
+  init_iselect ();
+
   coop_qinit (&coop_global_runq);
   coop_qinit (&coop_global_sleepq);
   coop_qinit (&coop_tmp_queue);
@@ -680,11 +788,11 @@
     }
 
 #ifdef GUILE_ISELECT
-  scm_I_am_dead = 1;
+  I_am_dead = 1;
   do {
     newthread = coop_wait_for_runnable_thread();
   } while (newthread == coop_global_curr);
-  scm_I_am_dead = 0;
+  I_am_dead = 0;
 #else
   newthread = coop_next_runnable_thread();
 #endif
@@ -783,6 +891,541 @@
 }
 
 #ifdef GUILE_ISELECT
+
+/* 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.  */
+static void
+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.  */
+    {
+      error_revive_threads ();
+      if (!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);
+}
+
+int
+scm_c_thread_select (int nfds, fd_set *readfds, fd_set *writefds, fd_set 
*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;
+}
 
 unsigned long 
 scm_thread_usleep (unsigned long usec)
Index: libguile/init.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/init.c,v
retrieving revision 1.115
diff -u -r1.115 init.c
--- libguile/init.c     2001/03/30 02:50:38     1.115
+++ libguile/init.c     2001/04/11 00:40:44
@@ -83,9 +83,6 @@
 #include "libguile/hash.h"
 #include "libguile/hashtab.h"
 #include "libguile/hooks.h"
-#ifdef GUILE_ISELECT
-#include "libguile/iselect.h"
-#endif
 #include "libguile/ioext.h"
 #include "libguile/keywords.h"
 #include "libguile/lang.h"
@@ -506,9 +503,6 @@
   scm_init_properties ();
   scm_init_hooks ();        /* Requires objprop until hook names are removed */
   scm_init_gc ();              /* Requires hooks, async */
-#ifdef GUILE_ISELECT
-  scm_init_iselect ();
-#endif
   scm_init_ioext ();
   scm_init_keywords ();
   scm_init_list ();
Index: libguile/iselect.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/iselect.c,v
retrieving revision 1.27
diff -u -r1.27 iselect.c
--- libguile/iselect.c  2001/03/10 16:56:06     1.27
+++ libguile/iselect.c  2001/04/11 00:40:44
@@ -53,588 +53,6 @@
 
 #include "libguile/iselect.h"
 
-#ifdef GUILE_ISELECT
-
-#include "libguile/coop-threads.h"
-
-#ifdef MISSING_BZERO_DECL
-extern void bzero (void *, size_t);
-#endif
-
-
-
-/* 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
-
-#ifdef HAVE_BZERO
-#define FD_ZERO_N(pos, n) bzero ((pos), (n))
-#else
-#define FD_ZERO_N(pos, n) memset ((void *) (pos), 0, (n))
-#endif
-
-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.  */
-int collisionp;
-
-/* These are the common fd sets.  When new select calls are made,
-   those sets are merged into these.  */
-int gnfds;
-SELECT_TYPE greadfds;
-SELECT_TYPE gwritefds;
-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.  */
-SELECT_TYPE rreadfds;
-SELECT_TYPE rwritefds;
-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);
-#ifndef SCM_MAGIC_SNARFER
-#include "libguile/iselect.x"
-#endif
-}
-
-#endif /* GUILE_ISELECT */
-
 int
 scm_internal_select (int nfds,
                     SELECT_TYPE *readfds,
@@ -644,64 +62,11 @@
 {
 #ifndef GUILE_ISELECT
   int res = select (nfds, readfds, writefds, exceptfds, timeout);
-  SCM_ASYNC_TICK;
-  return res;
 #else /* GUILE_ISELECT */
-  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;
+  int res = scm_c_thread_select (nfds, readfds, writefds, exceptfds, timeout);
+#endif
   SCM_ASYNC_TICK;
-  return coop_global_curr->retval;
-#endif /* GUILE_ISELECT */
+  return res;
 }
 
 /*
Index: libguile/iselect.h
===================================================================
RCS file: /cvs/guile/guile-core/libguile/iselect.h,v
retrieving revision 1.8
diff -u -r1.8 iselect.h
--- libguile/iselect.h  2000/03/19 19:01:12     1.8
+++ libguile/iselect.h  2001/04/11 00:40:44
@@ -92,10 +92,7 @@
 
 #ifdef GUILE_ISELECT
 
-extern int scm_I_am_dead;
-
-extern void scm_error_revive_threads (void);
-extern void scm_init_iselect (void);
+extern int scm_c_thread_select (int, fd_set *, fd_set *, fd_set *, struct 
timeval *);
 
 #endif /* GUILE_ISELECT */
 
-- 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]