Exemplo n.º 1
0
sexp sexp_mutex_unlock (sexp ctx, sexp self, sexp_sint_t n, sexp mutex, sexp condvar, sexp timeout) {
  sexp ls1, ls2;
  /* first unlock and unblock threads */
  if (sexp_truep(sexp_mutex_lockp(mutex))) {
    sexp_mutex_lockp(mutex) = SEXP_FALSE;
    sexp_mutex_thread(mutex) = ctx;
    /* search for threads blocked on this mutex */
    for (ls1=SEXP_NULL, ls2=sexp_global(ctx, SEXP_G_THREADS_PAUSED);
         sexp_pairp(ls2); ls1=ls2, ls2=sexp_cdr(ls2))
      if (sexp_context_event(sexp_car(ls2)) == mutex) {
        if (ls1==SEXP_NULL)
          sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(ls2);
        else
          sexp_cdr(ls1) = sexp_cdr(ls2);
        sexp_cdr(ls2) = sexp_global(ctx, SEXP_G_THREADS_FRONT);
        sexp_global(ctx, SEXP_G_THREADS_FRONT) = ls2;
        if (! sexp_pairp(sexp_cdr(ls2)))
          sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
        sexp_context_waitp(sexp_car(ls2))
          = sexp_context_timeoutp(sexp_car(ls2)) = 0;
        break;
      }
  }
  if (sexp_truep(condvar)) {
    /* wait on condition var if specified */
    sexp_context_waitp(ctx) = 1;
    sexp_context_event(ctx) = condvar;
    sexp_insert_timed(ctx, ctx, timeout);
    return SEXP_FALSE;
  }
  return SEXP_TRUE;
}
Exemplo n.º 2
0
sexp sexp_mutex_unlock (sexp ctx sexp_api_params(self, n), sexp mutex, sexp condvar, sexp timeout) {
  sexp ls1, ls2;
  if (sexp_not(condvar)) {
    /* normal unlock - always succeeds, just need to unblock threads */
    if (sexp_truep(sexp_mutex_lockp(mutex))) {
      sexp_mutex_lockp(mutex) = SEXP_FALSE;
      sexp_mutex_thread(mutex) = ctx;
      /* search for threads blocked on this mutex */
      for (ls1=SEXP_NULL, ls2=sexp_global(ctx, SEXP_G_THREADS_PAUSED);
           sexp_pairp(ls2); ls1=ls2, ls2=sexp_cdr(ls2))
        if (sexp_context_event(sexp_car(ls2)) == mutex) {
          if (ls1==SEXP_NULL)
            sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(ls2);
          else
            sexp_cdr(ls1) = sexp_cdr(ls2);
          sexp_cdr(ls2) = sexp_global(ctx, SEXP_G_THREADS_FRONT);
          sexp_global(ctx, SEXP_G_THREADS_FRONT) = ls2;
          if (! sexp_pairp(sexp_cdr(ls2)))
            sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
          sexp_context_waitp(sexp_car(ls2))
            = sexp_context_timeoutp(sexp_car(ls2)) = 0;
          break;
        }
    }
    return SEXP_TRUE;
  } else {
    /* wait on condition var */
    sexp_context_waitp(ctx) = 1;
    sexp_context_event(ctx) = condvar;
    sexp_insert_timed(ctx, ctx, timeout);
    return SEXP_FALSE;
  }
}
Exemplo n.º 3
0
sexp sexp_thread_sleep (sexp ctx sexp_api_params(self, n), sexp timeout) {
  sexp_context_waitp(ctx) = 1;
  if (timeout != SEXP_TRUE) {
    sexp_assert_type(ctx, sexp_numberp, SEXP_NUMBER, timeout);
    sexp_insert_timed(ctx, ctx, timeout);
  }
  return SEXP_FALSE;
}
Exemplo n.º 4
0
sexp sexp_thread_sleep (sexp ctx, sexp self, sexp_sint_t n, sexp timeout) {
  sexp_context_waitp(ctx) = 1;
  if (timeout != SEXP_TRUE) {
    sexp_assert_type(ctx, sexp_realp, SEXP_NUMBER, timeout);
    sexp_context_event(ctx) = SEXP_FALSE;
    sexp_insert_timed(ctx, ctx, timeout);
  }
  return SEXP_FALSE;
}
Exemplo n.º 5
0
sexp sexp_thread_join (sexp ctx, sexp self, sexp_sint_t n, sexp thread, sexp timeout) {
  sexp_assert_type(ctx, sexp_contextp, SEXP_CONTEXT, thread);
  if (sexp_context_refuel(thread) <= 0) /* return true if already terminated */ {
    return SEXP_TRUE;
  }
  sexp_context_timeoutp(ctx) = 0;
  sexp_context_waitp(ctx) = 1;
  sexp_context_event(ctx) = thread;
  sexp_insert_timed(ctx, ctx, timeout);
  return SEXP_FALSE;
}
Exemplo n.º 6
0
/* block the current thread on the specified port */
static sexp sexp_blocker (sexp ctx, sexp self, sexp_sint_t n, sexp port) {
  int fd;
  sexp_assert_type(ctx, sexp_portp, SEXP_IPORT, port);
  /* register the fd */
  fd = sexp_port_fileno(port);
  if (fd >= 0)
    sexp_insert_pollfd(ctx, fd, sexp_iportp(port) ? POLLIN : POLLOUT);
  /* pause the current thread */
  sexp_context_waitp(ctx) = 1;
  sexp_context_event(ctx) = port;
  sexp_insert_timed(ctx, ctx, SEXP_FALSE);
  return SEXP_VOID;
}
Exemplo n.º 7
0
sexp sexp_mutex_lock (sexp ctx, sexp self, sexp_sint_t n, sexp mutex, sexp timeout, sexp thread) {
  if (thread == SEXP_TRUE)
    thread = ctx;
  if (sexp_not(sexp_mutex_lockp(mutex))) {
    sexp_mutex_lockp(mutex) = SEXP_TRUE;
    sexp_mutex_thread(mutex) = thread;
    return SEXP_TRUE;
  } else {
    sexp_context_waitp(ctx) = 1;
    sexp_context_event(ctx) = mutex;
    sexp_insert_timed(ctx, ctx, timeout);
    return SEXP_FALSE;
  }
}
Exemplo n.º 8
0
/* block the current thread on the specified port */
static sexp sexp_blocker (sexp ctx, sexp self, sexp_sint_t n, sexp portorfd) {
  int fd;
  /* register the fd */
  if (sexp_portp(portorfd))
    fd = sexp_port_fileno(portorfd);
  else if (sexp_filenop(portorfd))
    fd = sexp_fileno_fd(portorfd);
  else if (sexp_fixnump(portorfd))
    fd = sexp_unbox_fixnum(portorfd);
  else
    return sexp_type_exception(ctx, self, SEXP_IPORT, portorfd);
  if (fd >= 0)
    sexp_insert_pollfd(ctx, fd, sexp_oportp(portorfd) ? POLLOUT : POLLIN);
  /* pause the current thread */
  sexp_context_waitp(ctx) = 1;
  sexp_context_event(ctx) = portorfd;
  sexp_insert_timed(ctx, ctx, SEXP_FALSE);
  return SEXP_VOID;
}
Exemplo n.º 9
0
sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) {
  int i, k;
  struct timeval tval;
  struct pollfd *pfds;
  useconds_t usecs = 0;
  sexp res, ls1, ls2, evt, runner, paused, front, pollfds;
  sexp_gc_var1(tmp);
  sexp_gc_preserve1(ctx, tmp);

  front  = sexp_global(ctx, SEXP_G_THREADS_FRONT);
  paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);

  /* check signals */
  if (sexp_global(ctx, SEXP_G_THREADS_SIGNALS) != SEXP_ZERO) {
    runner = sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER);
    if (! sexp_contextp(runner)) { /* ensure the runner exists */
      if (sexp_envp(runner)) {
        tmp = sexp_env_cell(runner, (tmp=sexp_intern(ctx, "signal-runner", -1)), 0);
        if (sexp_pairp(tmp) && sexp_procedurep(sexp_cdr(tmp))) {
          runner = sexp_make_thread(ctx, self, 2, sexp_cdr(tmp), SEXP_FALSE);
          sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = runner;
          sexp_thread_start(ctx, self, 1, runner);
          if (!sexp_pairp(front))
            front = sexp_global(ctx, SEXP_G_THREADS_FRONT);
        }
      }
    } else if (sexp_context_waitp(runner)) { /* wake it if it's sleeping */
      sexp_context_waitp(runner) = 0;
      sexp_thread_start(ctx, self, 1, runner);
    }
  }

  /* check blocked fds */
  pollfds = sexp_global(ctx, SEXP_G_THREADS_POLL_FDS);
  if (sexp_pollfdsp(ctx, pollfds) && sexp_pollfds_num_fds(pollfds) > 0) {
    pfds = sexp_pollfds_fds(pollfds);
    k = poll(sexp_pollfds_fds(pollfds), sexp_pollfds_num_fds(pollfds), 0);
    for (i=sexp_pollfds_num_fds(pollfds)-1; i>=0 && k>0; --i) {
      if (pfds[i].revents > 0) { /* free all threads blocked on this fd */
        k--;
        /* maybe unblock the current thread */
        evt = sexp_context_event(ctx);
        if ((sexp_portp(evt) && (sexp_port_fileno(evt) == pfds[i].fd))
            || (sexp_fixnump(evt) && (sexp_unbox_fixnum(evt) == pfds[i].fd))) {
          sexp_context_waitp(ctx) = 0;
          sexp_context_timeoutp(ctx) = 0;
          sexp_context_event(ctx) = SEXP_FALSE;
        }
        /* maybe unblock paused threads */
        for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
          /* TODO: distinguish input and output on the same fd? */
          evt = sexp_context_event(sexp_car(ls2));
          if ((sexp_portp(evt) && sexp_port_fileno(evt) == pfds[i].fd)
              || (sexp_fixnump(evt) && sexp_unbox_fixnum(evt) == pfds[i].fd)) {
            sexp_context_waitp(sexp_car(ls2)) = 0;
            sexp_context_timeoutp(sexp_car(ls2)) = 0;
            sexp_context_event(sexp_car(ls2)) = SEXP_FALSE;
            if (ls1==SEXP_NULL)
              sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = sexp_cdr(ls2);
            else
              sexp_cdr(ls1) = sexp_cdr(ls2);
            tmp = sexp_cdr(ls2);
            sexp_cdr(ls2) = SEXP_NULL;
            if (sexp_car(ls2) != ctx) {
              if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
                sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
              } else {
                sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
              }
              sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
            }
            ls2 = tmp;
          } else {
            ls1 = ls2;
            ls2 = sexp_cdr(ls2);
          }
        }
        if (i < (sexp_pollfds_num_fds(pollfds) - 1)) {
          pfds[i] = pfds[sexp_pollfds_num_fds(pollfds) - 1];
        }
        sexp_pollfds_num_fds(pollfds) -= 1;
      }
    }
  }

  /* if we've terminated, check threads joining us */
  if (sexp_context_refuel(ctx) <= 0) {
    for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
      if (sexp_context_event(sexp_car(ls2)) == ctx) {
        sexp_context_waitp(sexp_car(ls2)) = 0;
        sexp_context_timeoutp(sexp_car(ls2)) = 0;
        if (ls1==SEXP_NULL)
          sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = sexp_cdr(ls2);
        else
          sexp_cdr(ls1) = sexp_cdr(ls2);
        tmp = sexp_cdr(ls2);
        sexp_cdr(ls2) = SEXP_NULL;
        if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
          sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
        } else {
          sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
        }
        sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
        ls2 = tmp;
      } else {
        ls1 = ls2;
        ls2 = sexp_cdr(ls2);
      }
    }
  }

  /* check timeouts */
  if (sexp_pairp(paused)) {
    if (gettimeofday(&tval, NULL) == 0) {
      ls1 = SEXP_NULL;
      ls2 = paused;
      while (sexp_pairp(ls2) && sexp_context_before(sexp_car(ls2), tval)) {
        sexp_context_timeoutp(sexp_car(ls2)) = 1;
        sexp_context_waitp(sexp_car(ls2)) = 0;
        ls1 = ls2;
        ls2 = sexp_cdr(ls2);
      }
      if (sexp_pairp(ls1)) {
        sexp_cdr(ls1) = SEXP_NULL;
        if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
          sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = paused;
        } else {
          sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = paused;
        }
        sexp_global(ctx, SEXP_G_THREADS_BACK) = ls1;
        sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = ls2;
      }
    }
  }

  /* dequeue next thread */
  if (sexp_pairp(front)) {
    res = sexp_car(front);
    if ((sexp_context_refuel(ctx) <= 0) || sexp_context_waitp(ctx)) {
      /* orig ctx is either terminated or paused */
      sexp_global(ctx, SEXP_G_THREADS_FRONT) = sexp_cdr(front);
      if (! sexp_pairp(sexp_cdr(front)))
        sexp_global(ctx, SEXP_G_THREADS_BACK) = SEXP_NULL;
      if (sexp_context_refuel(ctx) > 0 && sexp_not(sexp_memq(ctx, ctx, paused)))
        sexp_insert_timed(ctx, ctx, SEXP_FALSE);
      paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);
    } else {
      /* swap with front of queue */
      sexp_car(sexp_global(ctx, SEXP_G_THREADS_FRONT)) = ctx;
      /* rotate front of queue to back */
      sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK))
        = sexp_global(ctx, SEXP_G_THREADS_FRONT);
      sexp_global(ctx, SEXP_G_THREADS_FRONT)
        = sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_FRONT));
      sexp_global(ctx, SEXP_G_THREADS_BACK)
        = sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK));
      sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = SEXP_NULL;
    }
  } else {
    /* no threads to dequeue */
    res = ctx;
    /* prefer a thread we can wait on instead of spinning */
    if (sexp_context_refuel(ctx) <= 0) {
      for (ls1=paused; sexp_pairp(ls1); ls1=sexp_cdr(ls1)) {
        evt = sexp_context_event(sexp_car(ls1));
        if (sexp_fixnump(evt) || sexp_portp(evt)) {
          res = sexp_car(ls1);
          break;
        }
      }
    }
  }

  if (sexp_context_waitp(res)) {
    /* the only thread available was waiting */
    if (sexp_pairp(paused)
        && sexp_context_before(sexp_car(paused), sexp_context_timeval(res))) {
      tmp = res;
      res = sexp_car(paused);
      paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(paused);
      if (sexp_not(sexp_memq(ctx, tmp, paused)))
        sexp_insert_timed(ctx, tmp, tmp);
    } else {
      sexp_delete_list(ctx, SEXP_G_THREADS_PAUSED, res);
    }
    paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);
    usecs = 0;
    if ((sexp_context_timeval(res).tv_sec == 0)
        && (sexp_context_timeval(res).tv_usec == 0)) {
      /* no timeout, wait for default 10ms */
      usecs = 10*1000;
    } else {
      /* wait until the next timeout */
      gettimeofday(&tval, NULL);
      if (tval.tv_sec <= sexp_context_timeval(res).tv_sec) {
        usecs = (sexp_context_timeval(res).tv_sec - tval.tv_sec) * 1000000;
        if (tval.tv_usec < sexp_context_timeval(res).tv_usec || usecs > 0)
          usecs += sexp_context_timeval(res).tv_usec - tval.tv_usec;
      }
    }
    /* take a nap to avoid busy looping */
    usleep(usecs);
    sexp_context_waitp(res) = 0;
    sexp_context_timeoutp(res) = 1;
  }

  sexp_gc_release1(ctx);
  return res;
}
Exemplo n.º 10
0
sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) {
  int i, k;
  struct timeval tval;
  struct pollfd *pfds;
  useconds_t usecs = 0;
  sexp res, ls1, ls2, runner, paused, front, pollfds;
  sexp_gc_var1(tmp);
  sexp_gc_preserve1(ctx, tmp);

  front  = sexp_global(ctx, SEXP_G_THREADS_FRONT);
  paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);

  /* check signals */
  if (sexp_global(ctx, SEXP_G_THREADS_SIGNALS) != SEXP_ZERO) {
    runner = sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER);
    if (! sexp_contextp(runner)) { /* ensure the runner exists */
      if (sexp_envp(runner)) {
        tmp = sexp_env_cell(runner, (tmp=sexp_intern(ctx, "signal-runner", -1)), 0);
        if (sexp_pairp(tmp) && sexp_procedurep(sexp_cdr(tmp))) {
          runner = sexp_make_thread(ctx, self, 2, sexp_cdr(tmp), SEXP_FALSE);
          sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = runner;
          sexp_thread_start(ctx, self, 1, runner);
        }
      }
    } else if (sexp_context_waitp(runner)) { /* wake it if it's sleeping */
      sexp_context_waitp(runner) = 0;
      sexp_thread_start(ctx, self, 1, runner);
    }
  }

  /* check blocked fds */
  pollfds = sexp_global(ctx, SEXP_G_THREADS_POLL_FDS);
  if (sexp_pollfdsp(ctx, pollfds) && sexp_pollfds_num_fds(pollfds) > 0) {
    pfds = sexp_pollfds_fds(pollfds);
    k = poll(sexp_pollfds_fds(pollfds), sexp_pollfds_num_fds(pollfds), 0);
  unblock_io_threads:
    for (i=sexp_pollfds_num_fds(pollfds)-1; i>=0 && k>0; --i) {
      if (pfds[i].revents > 0) { /* free all threads blocked on this fd */
        k--;
        pfds[i].events = 0;     /* FIXME: delete from queue completely */
        for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
          /* FIXME distinguish input and output on the same fd */
          if (sexp_portp(sexp_context_event(sexp_car(ls2)))
              && sexp_port_fileno(sexp_context_event(sexp_car(ls2))) == pfds[i].fd) {
            sexp_context_waitp(sexp_car(ls2)) = 0;
            sexp_context_timeoutp(sexp_car(ls2)) = 0;
            if (ls1==SEXP_NULL)
              sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = sexp_cdr(ls2);
            else
              sexp_cdr(ls1) = sexp_cdr(ls2);
            tmp = sexp_cdr(ls2);
            sexp_cdr(ls2) = SEXP_NULL;
            if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
              sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
            } else {
              sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
            }
            sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
            ls2 = tmp;
          } else {
            ls1 = ls2;
            ls2 = sexp_cdr(ls2);
          }
        }
      }
    }
  }

  /* if we've terminated, check threads joining us */
  if (sexp_context_refuel(ctx) <= 0) {
    for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
      if (sexp_context_event(sexp_car(ls2)) == ctx) {
        sexp_context_waitp(sexp_car(ls2)) = 0;
        sexp_context_timeoutp(sexp_car(ls2)) = 0;
        if (ls1==SEXP_NULL)
          sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = sexp_cdr(ls2);
        else
          sexp_cdr(ls1) = sexp_cdr(ls2);
        tmp = sexp_cdr(ls2);
        sexp_cdr(ls2) = SEXP_NULL;
	if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
	  sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
	} else {
	  sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
	}
	sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
        ls2 = tmp;
      } else {
        ls1 = ls2;
        ls2 = sexp_cdr(ls2);
      }
    }
  }

  /* check timeouts */
  if (sexp_pairp(paused)) {
    if (gettimeofday(&tval, NULL) == 0) {
      ls1 = SEXP_NULL;
      ls2 = paused;
      while (sexp_pairp(ls2) && sexp_context_before(sexp_car(ls2), tval)) {
        sexp_context_timeoutp(sexp_car(ls2)) = 1;
        sexp_context_waitp(ctx) = 0;
        ls1 = ls2;
        ls2 = sexp_cdr(ls2);
      }
      if (sexp_pairp(ls1)) {
        sexp_cdr(ls1) = SEXP_NULL;
	if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
	  sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = paused;
	} else {
	  sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = paused;
	}
	sexp_global(ctx, SEXP_G_THREADS_BACK) = ls1;
        sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = ls2;
      }
    }
  }

  /* dequeue next thread */
  if (sexp_pairp(front)) {
    res = sexp_car(front);
    if ((sexp_context_refuel(ctx) <= 0) || sexp_context_waitp(ctx)) {
      /* either terminated or paused */
      sexp_global(ctx, SEXP_G_THREADS_FRONT) = sexp_cdr(front);
      if (! sexp_pairp(sexp_cdr(front)))
        sexp_global(ctx, SEXP_G_THREADS_BACK) = SEXP_NULL;
    } else {
      /* swap with front of queue */
      sexp_car(sexp_global(ctx, SEXP_G_THREADS_FRONT)) = ctx;
      /* rotate front of queue to back */
      sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK))
        = sexp_global(ctx, SEXP_G_THREADS_FRONT);
      sexp_global(ctx, SEXP_G_THREADS_FRONT)
        = sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_FRONT));
      sexp_global(ctx, SEXP_G_THREADS_BACK)
        = sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK));
      sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = SEXP_NULL;
    }
  } else {
    res = ctx;
  }

  if (sexp_context_waitp(res)) {
    /* the only thread available was waiting */
    if (sexp_pairp(paused)
        && sexp_context_before(sexp_car(paused), sexp_context_timeval(res))) {
      tmp = res;
      res = sexp_car(paused);
      sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(paused);
      if (sexp_not(sexp_memq(ctx, tmp, paused)))
        sexp_insert_timed(ctx, tmp, tmp);
    }
    usecs = 0;
    if ((sexp_context_timeval(res).tv_sec == 0)
        && (sexp_context_timeval(res).tv_usec == 0)) {
      /* no timeout, wait for default 10ms */
      usecs = 10*1000;
    } else {
      /* wait until the next timeout */
      gettimeofday(&tval, NULL);
      if (tval.tv_sec <= sexp_context_timeval(res).tv_sec) {
        usecs = (sexp_context_timeval(res).tv_sec - tval.tv_sec) * 1000000;
        if (tval.tv_usec < sexp_context_timeval(res).tv_usec || usecs > 0)
          usecs += sexp_context_timeval(res).tv_usec - tval.tv_usec;
      }
    }
    /* either wait on an fd, or just sleep */
    pollfds = sexp_global(res, SEXP_G_THREADS_POLL_FDS);
    if (sexp_portp(sexp_context_event(res)) && sexp_pollfdsp(ctx, pollfds)) {
      if ((k = poll(sexp_pollfds_fds(pollfds), sexp_pollfds_num_fds(pollfds), usecs/1000)) > 0) {
        pfds = sexp_pollfds_fds(pollfds);
        goto unblock_io_threads;
      }
    } else {
      usleep(usecs);
      sexp_context_waitp(res) = 0;
      sexp_context_timeoutp(res) = 1;
    }
  }

  sexp_gc_release1(ctx);
  return res;
}