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

file descriptors open as binary ports by default

Browse source
This commit is contained in:
Alex Shinn 2012-05-18 23:00:30 +09:00
parent edbf07eaed
commit 7dd7d076dd
2 changed files with 34 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
lib/chibi/io/port.c
View file

@ -339,20 +339,31 @@ sexp sexp_read_u8 (sexp ctx, sexp self, sexp in) {
sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in); sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in);
if (!sexp_port_binaryp(in)) if (!sexp_port_binaryp(in))
return sexp_xtype_exception(ctx, self, "not a binary port", in); return sexp_xtype_exception(ctx, self, "not a binary port", in);
sexp_check_block_port(ctx, in, 0); #if SEXP_USE_GREEN_THREADS
errno = 0;
#endif
c = sexp_read_char(ctx, in); c = sexp_read_char(ctx, in);
return c == EOF ? SEXP_EOF : sexp_make_fixnum(c); if (c == EOF) {
#if SEXP_USE_GREEN_THREADS
if ((sexp_port_stream(in) ? ferror(sexp_port_stream(in)) : 1)
&& (errno == EAGAIN)
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
if (sexp_port_stream(in))
clearerr(sexp_port_stream(in));
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), in);
return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
}
#endif
return SEXP_EOF;
}
if (c == '\n') sexp_port_line(in)++;
else if (c < 0) c += 128;
return sexp_make_fixnum(c);
} }
sexp sexp_peek_u8 (sexp ctx, sexp self, sexp in) { sexp sexp_peek_u8 (sexp ctx, sexp self, sexp in) {
int c; sexp res = sexp_read_u8(ctx, self, in);
sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in); if (sexp_charp(res))
if (!sexp_port_binaryp(in)) sexp_push_char(ctx, sexp_unbox_character(res), in);
return sexp_xtype_exception(ctx, self, "not a binary port", in); return res;
sexp_check_block_port(ctx, in, 0);
c = sexp_read_char(ctx, in);
if (c == EOF)
return SEXP_EOF;
sexp_push_char(ctx, c, in);
return sexp_make_fixnum(c);
} }

15
sexp.c
View file

@ -1341,7 +1341,10 @@ sexp sexp_open_input_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp f
in = fdopen(sexp_fileno_fd(fileno), "r"); in = fdopen(sexp_fileno_fd(fileno), "r");
if (!in) return sexp_user_exception(ctx, SEXP_FALSE, "couldn't open fileno", fileno); if (!in) return sexp_user_exception(ctx, SEXP_FALSE, "couldn't open fileno", fileno);
res = sexp_make_input_port(ctx, in, SEXP_FALSE); res = sexp_make_input_port(ctx, in, SEXP_FALSE);
if (!sexp_exceptionp(res)) sexp_port_shutdownp(res) = sexp_truep(shutdownp); if (!sexp_exceptionp(res)) {
sexp_port_binaryp(res) = 1;
sexp_port_shutdownp(res) = sexp_truep(shutdownp);
}
return res; return res;
} }
@ -1536,6 +1539,7 @@ sexp sexp_open_input_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp f
if (!sexp_exceptionp(res)) { if (!sexp_exceptionp(res)) {
sexp_port_fd(res) = fileno; sexp_port_fd(res) = fileno;
sexp_port_offset(res) = SEXP_PORT_BUFFER_SIZE; sexp_port_offset(res) = SEXP_PORT_BUFFER_SIZE;
sexp_port_binaryp(res) = 1;
sexp_port_shutdownp(res) = sexp_truep(shutdownp); sexp_port_shutdownp(res) = sexp_truep(shutdownp);
} }
sexp_gc_release2(ctx); sexp_gc_release2(ctx);
@ -1649,15 +1653,18 @@ sexp sexp_set_port_fold_case (sexp ctx, sexp self, sexp_sint_t n, sexp in, sexp
int sexp_maybe_block_port (sexp ctx, sexp in, int forcep) { int sexp_maybe_block_port (sexp ctx, sexp in, int forcep) {
sexp f; sexp f;
int c; int c;
if (sexp_port_stream(in) && sexp_port_fileno(in) >= 0) { if ((sexp_port_stream(in) || sexp_filenop(sexp_port_fd(in)))
&& sexp_port_fileno(in) >= 0) {
if (sexp_port_flags(in) == SEXP_PORT_UNKNOWN_FLAGS) if (sexp_port_flags(in) == SEXP_PORT_UNKNOWN_FLAGS)
sexp_port_flags(in) = fcntl(sexp_port_fileno(in), F_GETFL); sexp_port_flags(in) = fcntl(sexp_port_fileno(in), F_GETFL);
if (sexp_port_flags(in) & O_NONBLOCK) { if (sexp_port_flags(in) & O_NONBLOCK) {
if (!forcep if (!forcep
&& (((c = sexp_read_char(ctx, in)) == EOF) && (((c = sexp_read_char(ctx, in)) == EOF)
&& sexp_port_stream(in) && sexp_port_stream(in)
&& ferror(sexp_port_stream(in)) && (errno == EAGAIN))) { && (sexp_port_stream(in) ? ferror(sexp_port_stream(in)) : 1)
clearerr(sexp_port_stream(in)); && (errno == EAGAIN))) {
if (sexp_port_stream(in))
clearerr(sexp_port_stream(in));
f = sexp_global(ctx, SEXP_G_THREADS_BLOCKER); f = sexp_global(ctx, SEXP_G_THREADS_BLOCKER);
if (sexp_opcodep(f)) { if (sexp_opcodep(f)) {
((sexp_proc2)sexp_opcode_func(f))(ctx, f, 1, in); ((sexp_proc2)sexp_opcode_func(f))(ctx, f, 1, in);