sexp sexp_read_u8 (sexp ctx, sexp self, sexp in) {
int c;
sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in);
if (!sexp_port_binaryp(in))
return sexp_xtype_exception(ctx, self, "not a binary port", in);
#if SEXP_USE_GREEN_THREADS
errno = 0;
#endif
c = sexp_read_char(ctx, in);
#if SEXP_USE_GREEN_THREADS
if ((c == EOF)
&& (errno == EAGAIN)) {
if (sexp_port_stream(in))
clearerr(sexp_port_stream(in));
if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER)))
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), in);
return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
}
#endif
if (c == '\n') sexp_port_line(in)++;
return (c==EOF) ? SEXP_EOF : sexp_make_fixnum(c);
}
sexp sexp_write_u8 (sexp ctx, sexp self, sexp u8, sexp out) {
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, u8);
if (sexp_unbox_fixnum(u8) < 0 || sexp_unbox_fixnum(u8) > 255)
return sexp_xtype_exception(ctx, self, "not a u8 value", u8);
sexp_assert_type(ctx, sexp_oportp, SEXP_OPORT, out);
if (!sexp_port_binaryp(out))
return sexp_xtype_exception(ctx, self, "not a binary port", out);
#if SEXP_USE_GREEN_THREADS
errno = 0;
#endif
if (sexp_write_char(ctx, sexp_unbox_fixnum(u8), out) == EOF) {
if (sexp_port_stream(out))
clearerr(sexp_port_stream(out));
#if SEXP_USE_GREEN_THREADS
if (errno == EAGAIN) {
if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER)))
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), out);
return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
}
#endif
}
return SEXP_VOID;
}
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);
}
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)));
}
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);
}
