Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Smarter polling in blocked output without threads, enable polling in blocked input.

Browse source 
Fixes issue #295.
This commit is contained in:
Alex Shinn 2015-12-30 14:07:50 +09:00
parent 72de1df228
commit 2c2ff588df
3 changed files with 38 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
include/chibi/features.h
View file

@ -684,6 +684,10 @@
#define SEXP_DEFAULT_EQUAL_BOUND 100000000
#endif
#ifndef SEXP_POLL_SLEEP_TIME
#define SEXP_POLL_SLEEP_TIME 5000
#endif
#ifndef SEXP_USE_IMAGE_LOADING
#define SEXP_USE_IMAGE_LOADING SEXP_USE_DL && !SEXP_USE_GLOBAL_HEAP && !SEXP_USE_BOEHM && !SEXP_USE_NO_FEATURES
#endif

11
include/chibi/sexp.h
View file

@ -21,6 +21,9 @@ extern "C" {
#define sexp_isdigit(x) ((isdigit)((int)(x)))
#define sexp_tolower(x) ((tolower)((int)(x)))
#define sexp_toupper(x) ((toupper)((int)(x)))
#define SEXP_USE_POLL_PORT 0
#define sexp_poll_input(ctx, port) usleep(SEXP_POLL_SLEEP_TIME)
#define sexp_poll_output(ctx, port) usleep(SEXP_POLL_SLEEP_TIME)
#else
#if SEXP_USE_DL
#include <dlfcn.h>
@ -31,6 +34,7 @@ extern "C" {
#endif
#if SEXP_USE_GREEN_THREADS
#include <sys/time.h>
#include <sys/select.h>
#include <fcntl.h>
#include <poll.h>
#endif
@ -39,6 +43,9 @@ extern "C" {
#define sexp_isdigit(x) (isdigit(x))
#define sexp_tolower(x) (tolower(x))
#define sexp_toupper(x) (toupper(x))
#define SEXP_USE_POLL_PORT 1
#define sexp_poll_input(ctx, port) sexp_poll_port(ctx, port, 1)
#define sexp_poll_output(ctx, port) sexp_poll_port(ctx, port, 0)
#endif
#if SEXP_USE_GC_FILE_DESCRIPTORS
@ -1586,6 +1593,10 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj
#define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(ctx, sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE))
#define sexp_debug(ctx, msg, obj) (sexp_portp(sexp_current_error_port(ctx)) ? (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx))) : 0)
#if SEXP_USE_POLL_PORT
SEXP_API int sexp_poll_port(sexp ctx, sexp port, int inputp);
#endif
/* simplify primitive API interface */
#define sexp_read(ctx, in) sexp_read_op(ctx, NULL, 1, in)

27
vm.c
View file

@ -979,6 +979,21 @@ static void* sexp_thread_debug_event(sexp ctx) {
#define sexp_ensure_stack(n)
#endif
/* used only when no thread scheduler has been loaded */
#if SEXP_USE_POLL_PORT
int sexp_poll_port(sexp ctx, sexp port, int inputp) {
fd_set fds;
int fd = sexp_port_fileno(port);
if (fd < 0) {
usleep(SEXP_POLL_SLEEP_TIME);
return -1;
}
FD_ZERO(&fds);
FD_SET(fd, &fds);
return select(1, (inputp ? &fds : NULL), (inputp ? NULL : &fds), NULL, NULL);
}
#endif
sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
unsigned char *ip;
sexp bc, cp, *stack = sexp_stack_data(sexp_context_stack(ctx));
@ -1965,8 +1980,8 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
if (sexp_port_stream(_ARG2)) clearerr(sexp_port_stream(_ARG2));
if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER)))
sexp_apply2(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG2, SEXP_FALSE);
else /* no scheduler but output full, wait 5ms */
usleep(5*1000);
else
sexp_poll_output(ctx, _ARG2);
fuel = 0;
ip--; /* try again */
goto loop;
@ -2015,8 +2030,8 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
/* TODO: the wait seems necessary on OS X to stop a print loop to ptys */
if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER)))
sexp_apply2(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG3, SEXP_FALSE);
else /* no scheduler but output full, wait 5ms */
usleep(5*1000);
else
sexp_poll_output(ctx, _ARG3);
fuel = 0;
ip--; /* try again */
goto loop;
@ -2050,6 +2065,8 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
/* TODO: block and unblock */
if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER)))
sexp_apply2(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG1, SEXP_FALSE);
else
sexp_poll_input(ctx, _ARG1);
fuel = 0;
ip--; /* try again */
} else
@ -2079,6 +2096,8 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG1));
if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER)))
sexp_apply2(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG1, SEXP_FALSE);
else
sexp_poll_input(ctx, _ARG1);
fuel = 0;
ip--; /* try again */
} else