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

char-ready? shouldn't block, should return #t on EOF

Browse source
This commit is contained in:
Alex Shinn 2012-10-21 18:10:45 +09:00
parent cec55dfe41
commit 4f554499f8
4 changed files with 41 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
include/chibi/sexp.h
View file

@ -32,6 +32,7 @@ extern "C" {
#if SEXP_USE_GREEN_THREADS
#include <sys/time.h>
#include <fcntl.h>
#include <poll.h>
#endif
#define sexp_isalpha(x) (isalpha(x))
#define sexp_isxdigit(x) (isxdigit(x))
@ -1352,6 +1353,7 @@ SEXP_API sexp sexp_read_complex_tail(sexp ctx, sexp in, sexp res);
#endif
SEXP_API sexp sexp_read_raw (sexp ctx, sexp in);
SEXP_API sexp sexp_read_op (sexp ctx, sexp self, sexp_sint_t n, sexp in);
SEXP_API sexp sexp_char_ready_p (sexp ctx, sexp self, sexp_sint_t n, sexp in);
SEXP_API sexp sexp_read_from_string (sexp ctx, const char *str, sexp_sint_t len);
SEXP_API sexp sexp_read_error (sexp ctx, const char *msg, sexp ir, sexp port);
SEXP_API sexp sexp_write_to_string (sexp ctx, sexp obj);

3
lib/init-7.scm
View file

@ -498,9 +498,6 @@
(define textual-port? port?)
(define (char-ready? . o)
(not (eof-object? (peek-char (if (pair? o) (car o) (current-input-port))))))
(define (call-with-input-string str proc)
(let* ((in (open-input-string str))
(res (proc in)))

1
opcodes.c
View file

@ -142,6 +142,7 @@ _OP(SEXP_OPC_IO, SEXP_OP_WRITE_STRING, 2, 3, SEXP_VOID, _I(SEXP_STRING), _I(SEXP
_OP(SEXP_OPC_IO, SEXP_OP_READ_CHAR, 0, 3, _I(SEXP_CHAR), _I(SEXP_IPORT), SEXP_FALSE, SEXP_FALSE, 0, "read-char", (sexp)"current-input-port", NULL),
_OP(SEXP_OPC_IO, SEXP_OP_PEEK_CHAR, 0, 3, _I(SEXP_CHAR), _I(SEXP_IPORT), SEXP_FALSE, SEXP_FALSE, 0, "peek-char", (sexp)"current-input-port", NULL),
#endif
_FN1OPTP(_I(SEXP_BOOLEAN), _I(SEXP_IPORT), "char-ready?", (sexp)"current-input-port", sexp_char_ready_p),
_FN1OPTP(_I(SEXP_OBJECT), _I(SEXP_IPORT), "read", (sexp)"current-input-port", sexp_read_op),
_FN2OPTP(SEXP_VOID,_I(SEXP_OBJECT), _I(SEXP_OPORT), "write", (sexp)"current-output-port", sexp_write_op),
_FN1OPTP(SEXP_VOID, _I(SEXP_OPORT), "flush-output", (sexp)"current-output-port", sexp_flush_output_op),

38
sexp.c
View file

@ -1732,6 +1732,44 @@ void sexp_maybe_unblock_port (sexp ctx, sexp port) {
}
#endif
#if SEXP_USE_GREEN_THREADS
static int sexp_fileno_ready_p (int fd) {
struct pollfd pfd;
if (fd < 0) return -1;
pfd.fd = fd;
pfd.events = POLLIN;
return poll(&pfd, 1, 0) == 1;
}
static int sexp_stream_ready_p (FILE* in) {
int flags = fcntl(fileno(in), F_GETFL), res;
if (! (flags & O_NONBLOCK)) fcntl(fileno(in), F_SETFL, flags & O_NONBLOCK);
res = getc(in);
if (! (flags & O_NONBLOCK)) fcntl(fileno(in), F_SETFL, flags);
return (res == EOF) ? feof(in) : 1;
}
#endif
sexp sexp_char_ready_p (sexp ctx, sexp self, sexp_sint_t n, sexp in) {
sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in);
if (!sexp_port_openp(in))
return SEXP_FALSE;
#if !SEXP_USE_STRING_STREAMS
if (sexp_port_buf(in))
if (sexp_port_offset(in) < sexp_port_size(in)
|| (!sexp_filenop(sexp_port_fd(in)) && !sexp_port_stream(in)))
return SEXP_TRUE;
#endif
#if SEXP_USE_GREEN_THREADS /* maybe not just when threads are enabled */
if (sexp_filenop(sexp_port_fd(in)))
return sexp_make_boolean(sexp_fileno_ready_p(sexp_port_fileno(in)));
else if (sexp_port_stream(in))
return sexp_make_boolean(sexp_stream_ready_p(sexp_port_stream(in)));
#endif
/* for custom ports and unthreaded compiles we just return true for now */
return SEXP_TRUE;
}
#define NUMBUF_LEN 32
static struct {const char* name; char ch;} sexp_char_names[] = {