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

Binding a socket makes it non-blocking by default.

Browse source 
Allowing primitives (currently only send/receive) to block just once
with SEXP_G_IO_BLOCK_ONCE_ERROR.
This commit is contained in:
Alex Shinn 2014-09-28 16:20:45 +09:00
parent 4c5788ff11
commit f759076d2b
5 changed files with 21 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
eval.c
View file

@ -490,6 +490,8 @@ void sexp_init_eval_context_globals (sexp ctx) {
#if SEXP_USE_GREEN_THREADS
sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR)
= sexp_user_exception(ctx, SEXP_FALSE, "I/O would block", SEXP_NULL);
sexp_global(ctx, SEXP_G_IO_BLOCK_ONCE_ERROR)
= sexp_user_exception(ctx, SEXP_FALSE, "I/O would block once", SEXP_NULL);
sexp_global(ctx, SEXP_G_THREADS_FRONT) = SEXP_NULL;
sexp_global(ctx, SEXP_G_THREADS_BACK) = SEXP_NULL;
sexp_global(ctx, SEXP_G_THREADS_SIGNALS) = SEXP_ZERO;

1
include/chibi/sexp.h
View file

@ -1232,6 +1232,7 @@ enum sexp_context_globals {
#endif
#if SEXP_USE_GREEN_THREADS
SEXP_G_IO_BLOCK_ERROR,
SEXP_G_IO_BLOCK_ONCE_ERROR,
SEXP_G_THREADS_SCHEDULER,
SEXP_G_THREADS_FRONT,
SEXP_G_THREADS_BACK,

17
lib/chibi/accept.c
View file

@ -39,7 +39,7 @@ sexp sexp_sendto (sexp ctx, sexp self, int sock, const void* buffer, size_t len,
f = sexp_global(ctx, SEXP_G_THREADS_BLOCKER);
if (sexp_applicablep(f)) {
sexp_apply2(ctx, f, sexp_make_fixnum(sock), timeout);
return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
return sexp_global(ctx, SEXP_G_IO_BLOCK_ONCE_ERROR);
}
}
#endif
@ -57,15 +57,24 @@ sexp sexp_recvfrom (sexp ctx, sexp self, int sock, void* buffer, size_t len, int
f = sexp_global(ctx, SEXP_G_THREADS_BLOCKER);
if (sexp_applicablep(f)) {
sexp_apply2(ctx, f, sexp_make_fixnum(sock), timeout);
return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
return sexp_global(ctx, SEXP_G_IO_BLOCK_ONCE_ERROR);
}
}
#endif
return sexp_make_fixnum(res);
}
/* If we're listening on a socket from Scheme, we most likely want it */
/* to be non-blocking. */
/* If we're binding or listening on a socket from Scheme, we most */
/* likely want it to be non-blocking. */
sexp sexp_bind (sexp ctx, sexp self, int fd, struct sockaddr* addr, socklen_t addr_len) {
int res = bind(fd, addr, addr_len);
#if SEXP_USE_GREEN_THREADS
if (res >= 0)
fcntl(fd, F_SETFL, fcntl(fd, F_GETFL) | O_NONBLOCK);
#endif
return (res == 0) ? SEXP_TRUE : SEXP_FALSE;
}
sexp sexp_listen (sexp ctx, sexp self, sexp fileno, sexp backlog) {
int fd, res;

3
lib/chibi/net.stub
View file

@ -32,7 +32,8 @@
;;> Bind a name to a socket.
(define-c errno bind (fileno sockaddr int))
(define-c sexp (bind "sexp_bind")
((value ctx sexp) (value self sexp) fileno sockaddr int))
;;> Listen on a socket.

3
vm.c
View file

@ -883,6 +883,9 @@ static int sexp_check_type(sexp ctx, sexp a, sexp b) {
if (sexp_exceptionp(x)) { \
if (x == sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR)) { \
fuel = 0; ip--; goto loop; \
} else if (x == sexp_global(ctx, SEXP_G_IO_BLOCK_ONCE_ERROR)) { \
stack[top-i+1] = SEXP_ZERO; \
fuel = 0; ip--; goto loop; \
} else { \
top -= i; \
_ARG1 = x; \