示例#1
0
static sexp sexp_get_file_descriptor_status_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
  sexp res;
  if (! (sexp_portp(arg0) || sexp_filenop(arg0) || sexp_fixnump(arg0)))
    return sexp_xtype_exception(ctx, self, "not a port or file descriptor",arg0);
  res = sexp_make_integer(ctx, fcntl((sexp_portp(arg0) ? sexp_port_fileno(arg0) : sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0)), F_GETFL));
  return res;
}
示例#2
0
static sexp sexp_is_a_tty_p_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
  sexp res;
  if (! (sexp_portp(arg0) || sexp_filenop(arg0) || sexp_fixnump(arg0)))
    return sexp_xtype_exception(ctx, self, "not a port or file descriptor",arg0);
  res = sexp_make_boolean(isatty((sexp_portp(arg0) ? sexp_port_fileno(arg0) : sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0))));
  return res;
}
示例#3
0
static sexp sexp_file_truncate_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
  sexp res;
  if (! (sexp_portp(arg0) || sexp_filenop(arg0) || sexp_fixnump(arg0)))
    return sexp_xtype_exception(ctx, self, "not a port or file descriptor",arg0);
  if (! sexp_exact_integerp(arg1))
    return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
  res = sexp_make_integer(ctx, ftruncate((sexp_portp(arg0) ? sexp_port_fileno(arg0) : sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0)), sexp_uint_value(arg1)));
  return res;
}
示例#4
0
static sexp sexp_set_file_descriptor_flags_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg2) {
  int err;
  sexp res;
  if (! (sexp_portp(arg0) || sexp_filenop(arg0) || sexp_fixnump(arg0)))
    return sexp_xtype_exception(ctx, self, "not a port or file descriptor",arg0);
  if (! sexp_exact_integerp(arg2))
    return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
  err = fcntl((sexp_portp(arg0) ? sexp_port_fileno(arg0) : sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0)), F_SETFD, sexp_sint_value(arg2));
  if (err) {
  res = SEXP_FALSE;
  } else {
  res = SEXP_TRUE;
  }
  return res;
}
示例#5
0
static void sexp_make_unblocking (sexp ctx, sexp port) {
  if (!(sexp_portp(port) && sexp_port_fileno(port) >= 0))
    return;
  if (sexp_port_flags(port) == SEXP_PORT_UNKNOWN_FLAGS)
    sexp_port_flags(port) = fcntl(sexp_port_fileno(port), F_GETFL);
  if (!(sexp_port_flags(port) & O_NONBLOCK))
    if (fcntl(sexp_port_fileno(port), F_SETFL, sexp_port_flags(port) | O_NONBLOCK) == 0)
      sexp_port_flags(port) |= O_NONBLOCK;
}
示例#6
0
static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
  sexp_gc_var3(e, p, res);
  sexp_gc_preserve3(ctx, e, p, res);
  e = sexp_load_standard_env(ctx, env, k);
  if (sexp_exceptionp(e)) return e;
  sexp_load_standard_ports(ctx, e, stdin, stdout, stderr, 0);
#if SEXP_USE_GREEN_THREADS
  p  = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
  if (sexp_portp(p)) sexp_maybe_block_port(ctx, p, 1);
#endif
  res = sexp_make_env(ctx);
  sexp_env_parent(res) = e;
  sexp_set_parameter(ctx, res, sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), res);
  sexp_gc_release3(ctx);
  return res;
}
示例#7
0
sexp sexp_seek (sexp ctx, sexp self, sexp x, off_t offset, int whence) {
  off_t res;
  if (! (sexp_portp(x) || sexp_filenop(x)))
    return sexp_type_exception(ctx, self, SEXP_IPORT, x);
  if (sexp_filenop(x))
    return sexp_make_integer(ctx, lseek(sexp_fileno_fd(x), offset, whence));
  if (sexp_filenop(sexp_port_fd(x))) {
    res = lseek(sexp_fileno_fd(sexp_port_fd(x)), offset, whence);
    if (res >= 0 && !(whence == SEEK_CUR && offset == 0))
      sexp_port_offset(x) = 0;
    return sexp_make_integer(ctx, res);
  }
  if (sexp_stream_portp(x))
    return sexp_make_integer(ctx, fseek(sexp_port_stream(x), offset, whence));
  return sexp_xtype_exception(ctx, self, "not a seekable port", x);
}
示例#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;
}
示例#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;
}
示例#10
0
sexp sexp_fileno (sexp ctx, sexp self, sexp_sint_t n, sexp port) {
  if (! sexp_portp(port))
    return sexp_type_exception(ctx, self, SEXP_IPORT, port);
  return sexp_make_fixnum(fileno(sexp_port_stream(port)));
}
示例#11
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;
}
示例#12
0
sexp sexp_tell (sexp ctx, sexp self, sexp x) {
  if (sexp_portp(x) && sexp_stream_portp(x))
    return sexp_make_integer(ctx, ftell(sexp_port_stream(x)));
  return sexp_seek(ctx, self, x, 0, SEEK_CUR);
}