mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 06:09:18 +02:00
Various fixes for non-string-streams non-blocking i/o.
Moving open-input/output-file-descriptor to core.
This commit is contained in:
Alex Shinn
parent
686b5adcfc
commit
cef6bb6794
8 changed files with 164 additions and 109 deletions
|
|
@ -324,7 +324,8 @@ struct sexp_struct {
|
|||
struct {
|
||||
FILE *stream;
|
||||
char *buf;
|
||||
char openp, bidirp, binaryp, no_closep, sourcep, blockedp, fold_casep;
|
||||
char openp, bidirp, binaryp, shutdownp, no_closep, sourcep,
|
||||
blockedp, fold_casep;
|
||||
sexp_uint_t offset, line, flags;
|
||||
size_t size;
|
||||
sexp name;
|
||||
|
|
@ -332,7 +333,7 @@ struct sexp_struct {
|
|||
sexp fd;
|
||||
} port;
|
||||
struct {
|
||||
char openp, socketp, no_closep;
|
||||
char openp, no_closep;
|
||||
sexp_sint_t fd;
|
||||
} fileno;
|
||||
struct {
|
||||
|
|
@ -865,6 +866,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
|
|||
#define sexp_port_openp(p) (sexp_pred_field(p, port, sexp_portp, openp))
|
||||
#define sexp_port_bidirp(p) (sexp_pred_field(p, port, sexp_portp, bidirp))
|
||||
#define sexp_port_binaryp(p) (sexp_pred_field(p, port, sexp_portp, binaryp))
|
||||
#define sexp_port_shutdownp(p) (sexp_pred_field(p, port, sexp_portp, shutdownp))
|
||||
#define sexp_port_no_closep(p) (sexp_pred_field(p, port, sexp_portp, no_closep))
|
||||
#define sexp_port_sourcep(p) (sexp_pred_field(p, port, sexp_portp, sourcep))
|
||||
#define sexp_port_blockedp(p) (sexp_pred_field(p, port, sexp_portp, blockedp))
|
||||
|
|
@ -1213,6 +1215,7 @@ enum sexp_context_globals {
|
|||
#define sexp_push_char(x, c, p) (ungetc(c, sexp_port_stream(p)))
|
||||
#define sexp_write_char(x, c, p) (putc(c, sexp_port_stream(p)))
|
||||
#define sexp_write_string(x, s, p) (fputs(s, sexp_port_stream(p)))
|
||||
#define sexp_write_string_n(x, s, n, p) (fwrite(s, 1, n, sexp_port_stream(p)))
|
||||
#define sexp_flush(x, p) (fflush(sexp_port_stream(p)))
|
||||
|
||||
#else
|
||||
|
|
@ -1221,6 +1224,7 @@ enum sexp_context_globals {
|
|||
#define sexp_push_char(x, c, p) ((c!=EOF) && (sexp_port_buf(p) ? (sexp_port_buf(p)[--sexp_port_offset(p)] = ((char)(c))) : ungetc(c, sexp_port_stream(p))))
|
||||
#define sexp_write_char(x, c, p) (sexp_port_buf(p) ? ((sexp_port_offset(p) < sexp_port_size(p)) ? ((((sexp_port_buf(p))[sexp_port_offset(p)++]) = (char)(c)), 0) : sexp_buffered_write_char(x, c, p)) : putc(c, sexp_port_stream(p)))
|
||||
#define sexp_write_string(x, s, p) (sexp_port_buf(p) ? sexp_buffered_write_string(x, s, p) : fputs(s, sexp_port_stream(p)))
|
||||
#define sexp_write_string_n(x, s, n, p) (sexp_port_buf(p) ? sexp_buffered_write_string_n(x, s, n, p) : fwrite(s, 1, n, sexp_port_stream(p)))
|
||||
#define sexp_flush(x, p) (sexp_port_buf(p) ? sexp_buffered_flush(x, p) : fflush(sexp_port_stream(p)))
|
||||
|
||||
SEXP_API int sexp_buffered_read_char (sexp ctx, sexp p);
|
||||
|
|
@ -1284,9 +1288,11 @@ SEXP_API sexp sexp_read_from_string (sexp ctx, const char *str, sexp_sint_t len)
|
|||
SEXP_API sexp sexp_write_to_string (sexp ctx, sexp obj);
|
||||
SEXP_API sexp sexp_write_simple_object (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp writer, sexp out);
|
||||
SEXP_API sexp sexp_finalize_port (sexp ctx, sexp self, sexp_sint_t n, sexp port);
|
||||
SEXP_API sexp sexp_make_fileno (sexp ctx, int fd, int socketp);
|
||||
SEXP_API sexp sexp_make_fileno (sexp ctx, int fd, int no_closep);
|
||||
SEXP_API sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name);
|
||||
SEXP_API sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name);
|
||||
SEXP_API sexp sexp_open_input_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp fileno, sexp socketp);
|
||||
SEXP_API sexp sexp_open_output_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp fileno, sexp socketp);
|
||||
SEXP_API sexp sexp_make_non_null_input_port (sexp ctx, FILE* in, sexp name);
|
||||
SEXP_API sexp sexp_make_non_null_output_port (sexp ctx, FILE* out, sexp name);
|
||||
SEXP_API sexp sexp_make_non_null_input_output_port (sexp ctx, FILE* io, sexp name);
|
||||
|
|
@ -1386,7 +1392,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj
|
|||
#define sexp_write(ctx, obj, out) sexp_write_op(ctx, NULL, 2, obj, out)
|
||||
#define sexp_display(ctx, obj, out) sexp_display_op(ctx, NULL, 2, obj, out)
|
||||
#define sexp_print_exception(ctx, e, out) sexp_print_exception_op(ctx, NULL, 2, e, out)
|
||||
#define sexp_flush_output(ctx, obj, out) sexp_flush_output_op(ctx, NULL, 1, out)
|
||||
#define sexp_flush_output(ctx, out) sexp_flush_output_op(ctx, NULL, 1, out)
|
||||
#define sexp_equalp(ctx, a, b) sexp_equalp_op(ctx, NULL, 2, a, b)
|
||||
#define sexp_listp(ctx, x) sexp_listp_op(ctx, NULL, 1, x)
|
||||
#define sexp_length(ctx, x) sexp_length_op(ctx, NULL, 1, x)
|
||||
|
|
|
|||
|
|
@ -19,20 +19,18 @@ sexp sexp_accept (sexp ctx, sexp self, int sock, struct sockaddr* addr, socklen_
|
|||
}
|
||||
}
|
||||
#endif
|
||||
return sexp_make_fileno(ctx, res, 1);
|
||||
return sexp_make_fileno(ctx, res, 0);
|
||||
}
|
||||
|
||||
/* If we're listening on a socket from Scheme, we most likely want it */
|
||||
/* to be non-blocking. */
|
||||
|
||||
sexp sexp_listen (sexp ctx, sexp self, sexp arg0, sexp arg1) {
|
||||
sexp sexp_listen (sexp ctx, sexp self, sexp fileno, sexp backlog) {
|
||||
int fd, res;
|
||||
if (! sexp_exact_integerp(arg0))
|
||||
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
|
||||
if (! sexp_exact_integerp(arg1))
|
||||
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
|
||||
fd = sexp_sint_value(arg0);
|
||||
res = listen(fd, sexp_sint_value(arg1));
|
||||
sexp_assert_type(ctx, sexp_filenop, SEXP_FILENO, fileno);
|
||||
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, backlog);
|
||||
fd = sexp_fileno_fd(fileno);
|
||||
res = listen(fd, sexp_unbox_fixnum(backlog));
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
if (res >= 0)
|
||||
fcntl(fd, F_SETFL, fcntl(fd, F_GETFL) | O_NONBLOCK);
|
||||
|
|
|
|||
|
|
@ -5,9 +5,7 @@
|
|||
;;> objects in a future release.
|
||||
|
||||
(define-library (chibi filesystem)
|
||||
(export open-input-file-descriptor open-output-file-descriptor
|
||||
;; open-input-output-file-descriptor
|
||||
duplicate-file-descriptor duplicate-file-descriptor-to
|
||||
(export duplicate-file-descriptor duplicate-file-descriptor-to
|
||||
close-file-descriptor renumber-file-descriptor
|
||||
delete-file link-file symbolic-link-file rename-file
|
||||
directory-files directory-fold create-directory delete-directory
|
||||
|
|
|
|||
|
|
@ -65,15 +65,15 @@
|
|||
(define-c errno fstat (int (result stat)))
|
||||
(define-c errno (file-link-status "lstat") (string (result stat)))
|
||||
|
||||
;;> Creates a new input-port from the file descriptor @var{int}.
|
||||
;; Creates a new input-port from the file descriptor @var{int}.
|
||||
|
||||
(define-c input-port (open-input-file-descriptor "fdopen")
|
||||
(fileno (value "r" string)))
|
||||
;; (define-c input-port (open-input-file-descriptor "fdopen")
|
||||
;; (fileno (value "r" string)))
|
||||
|
||||
;;> Creates a new output-port from the file descriptor @var{int}.
|
||||
;; Creates a new output-port from the file descriptor @var{int}.
|
||||
|
||||
(define-c output-port (open-output-file-descriptor "fdopen")
|
||||
(fileno (value "w" string)))
|
||||
;; (define-c output-port (open-output-file-descriptor "fdopen")
|
||||
;; (fileno (value "w" string)))
|
||||
|
||||
;; Creates a new bidirectional port from the file descriptor @var{int}.
|
||||
|
||||
|
|
|
|||
|
|
@ -19,9 +19,9 @@
|
|||
|
||||
;;> Opens a client net connection to @var{host}, a string,
|
||||
;;> on port @var{service}, which can be a string such as
|
||||
;;> @scheme{"http"} or an integer. Returns a list of two
|
||||
;;> values on success - an input port and output port -
|
||||
;;> or @scheme{#f} on failure.
|
||||
;;> @scheme{"http"} or an integer. Returns a list of three
|
||||
;;> values on success - the socket, an input port, and an
|
||||
;;> output port - or @scheme{#f} on failure.
|
||||
|
||||
(define (open-net-io host service)
|
||||
(let lp ((addr (get-address-info host service)))
|
||||
|
|
@ -42,13 +42,8 @@
|
|||
(cond-expand
|
||||
(threads (set-file-descriptor-flags! sock open/non-block))
|
||||
(else #f))
|
||||
(cond-expand
|
||||
(bidir-ports
|
||||
(let ((port (open-input-output-file-descriptor sock)))
|
||||
(list port port)))
|
||||
(else
|
||||
(list (open-input-file-descriptor sock)
|
||||
(open-output-file-descriptor sock)))))))))))
|
||||
(list (open-input-file-descriptor sock #t)
|
||||
(open-output-file-descriptor sock #t)))))))))
|
||||
|
||||
;;> Convenience wrapper around @scheme{open-net-io}, opens
|
||||
;;> the connection then calls @var{proc} with two arguments,
|
||||
|
|
@ -61,9 +56,10 @@
|
|||
(let ((io (open-net-io host service)))
|
||||
(if (not (pair? io))
|
||||
(error "couldn't find address" host service)
|
||||
(let ((res (proc (car io) (cadr io))))
|
||||
(close-input-port (car io))
|
||||
(close-output-port (cadr io))
|
||||
(let ((res (proc (cadr io) (caddr io))))
|
||||
(close-input-port (cadr io))
|
||||
(close-output-port (caddr io))
|
||||
(close-file-descriptor (car io))
|
||||
res))))
|
||||
|
||||
;;> @subsubsubsection{@scheme{(make-listener-socket addrinfo [max-conn])}}
|
||||
|
|
@ -80,7 +76,7 @@
|
|||
(address-info-socket-type addrinfo)
|
||||
(address-info-protocol addrinfo))))
|
||||
(cond
|
||||
((negative? sock)
|
||||
((not sock)
|
||||
(error "couldn't create socket for: " addrinfo))
|
||||
((not (set-socket-option! sock level/socket socket-opt/reuseaddr 1))
|
||||
(error "couldn't set the socket to be reusable" addrinfo))
|
||||
|
|
@ -88,10 +84,10 @@
|
|||
(address-info-address addrinfo)
|
||||
(address-info-address-length addrinfo)))
|
||||
(close-file-descriptor sock)
|
||||
(error "couldn't bind socket for: " addrinfo))
|
||||
(error "couldn't bind socket" sock addrinfo))
|
||||
((not (listen sock max-connections))
|
||||
(close-file-descriptor sock)
|
||||
(error "couldn't listen on socket for: " addrinfo))
|
||||
(error "couldn't listen on socket" sock addrinfo))
|
||||
(else
|
||||
sock))))
|
||||
|
||||
|
|
|
|||
|
|
@ -90,6 +90,7 @@ _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJ
|
|||
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "string?", _I(SEXP_STRING), 0),
|
||||
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "vector?", _I(SEXP_VECTOR), 0),
|
||||
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "bytevector?", _I(SEXP_BYTES), 0),
|
||||
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "fileno?", _I(SEXP_FILENO), 0),
|
||||
#if SEXP_USE_IMMEDIATE_FLONUMS
|
||||
_FN1(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "flonum?", 0, sexp_flonump_op),
|
||||
#else
|
||||
|
|
@ -170,6 +171,8 @@ _FN1(_I(SEXP_OBJECT), _I(SEXP_OBJECT), "strip-syntactic-closures", 0, sexp_strip
|
|||
_FN0(_I(SEXP_OPORT), "open-output-string", 0, sexp_make_output_string_port_op),
|
||||
_FN1(_I(SEXP_IPORT), _I(SEXP_STRING), "open-input-string", 0, sexp_make_input_string_port_op),
|
||||
_FN1(_I(SEXP_STRING), _I(SEXP_OPORT), "get-output-string", 0, sexp_get_output_string_op),
|
||||
_FN2OPT(_I(SEXP_IPORT), _I(SEXP_FIXNUM), _I(SEXP_BOOLEAN), "open-input-file-descriptor", SEXP_FALSE, sexp_open_input_file_descriptor),
|
||||
_FN2OPT(_I(SEXP_OPORT), _I(SEXP_FIXNUM), _I(SEXP_BOOLEAN), "open-output-file-descriptor", SEXP_FALSE, sexp_open_output_file_descriptor),
|
||||
_FN2OPT(_I(SEXP_OBJECT), _I(SEXP_PROCEDURE), _I(SEXP_FIXNUM), "register-optimization!", _I(600), sexp_register_optimization),
|
||||
#if SEXP_USE_MATH
|
||||
_FN1(_I(SEXP_NUMBER), _I(SEXP_NUMBER), "exp", 0, sexp_exp),
|
||||
|
|
|
|||
126
sexp.c
126
sexp.c
|
|
@ -112,10 +112,13 @@ sexp sexp_write_simple_object (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sex
|
|||
#endif
|
||||
|
||||
sexp sexp_finalize_port (sexp ctx, sexp self, sexp_sint_t n, sexp port) {
|
||||
sexp res = SEXP_VOID;
|
||||
if (sexp_port_openp(port)) {
|
||||
sexp_port_openp(port) = 0;
|
||||
if (sexp_port_stream(port) && ! sexp_port_no_closep(port)) {
|
||||
/* close the stream */
|
||||
fclose(sexp_port_stream(port));
|
||||
/* free the buffer if allocated */
|
||||
if (sexp_port_buf(port)
|
||||
&& (sexp_oportp(port)
|
||||
#if !SEXP_USE_STRING_STREAMS
|
||||
|
|
@ -123,18 +126,23 @@ sexp sexp_finalize_port (sexp ctx, sexp self, sexp_sint_t n, sexp port) {
|
|||
#endif
|
||||
))
|
||||
free(sexp_port_buf(port));
|
||||
}
|
||||
#ifndef PLAN9
|
||||
} else if (sexp_filenop(sexp_port_fd(port))
|
||||
&& sexp_fileno_socketp(sexp_port_fd(port))
|
||||
&& !sexp_fileno_no_closep(sexp_port_fd(port))) {
|
||||
if (sexp_filenop(sexp_port_fd(port))
|
||||
&& sexp_fileno_openp(sexp_port_fd(port))) {
|
||||
if (sexp_oportp(port)) res = sexp_flush_output(ctx, port);
|
||||
if (sexp_exceptionp(res)) return res;
|
||||
if (sexp_port_shutdownp(port)) {
|
||||
/* shutdown the socket if requested */
|
||||
if (sexp_iportp(port))
|
||||
shutdown(sexp_fileno_fd(sexp_port_fd(port)), SHUT_RD);
|
||||
shutdown(sexp_port_fileno(port), sexp_oportp(port) ? SHUT_RDWR : SHUT_RD);
|
||||
if (sexp_oportp(port))
|
||||
shutdown(sexp_fileno_fd(sexp_port_fd(port)), SHUT_WR);
|
||||
shutdown(sexp_port_fileno(port), SHUT_WR);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
}
|
||||
return SEXP_VOID;
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_finalize_fileno (sexp ctx, sexp self, sexp_sint_t n, sexp fileno) {
|
||||
|
|
@ -1322,6 +1330,28 @@ sexp sexp_get_output_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp port) {
|
|||
|
||||
#endif
|
||||
|
||||
sexp sexp_open_input_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp fileno, sexp shutdownp) {
|
||||
sexp res;
|
||||
FILE* in;
|
||||
sexp_assert_type(ctx, sexp_filenop, SEXP_FILENO, fileno);
|
||||
in = fdopen(sexp_fileno_fd(fileno), "r");
|
||||
if (!in) return sexp_user_exception(ctx, SEXP_FALSE, "couldn't open fileno", fileno);
|
||||
res = sexp_make_input_port(ctx, in, SEXP_FALSE);
|
||||
if (!sexp_exceptionp(res)) sexp_port_shutdownp(res) = sexp_truep(shutdownp);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_open_output_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp fileno, sexp shutdownp) {
|
||||
sexp res;
|
||||
FILE* out;
|
||||
sexp_assert_type(ctx, sexp_filenop, SEXP_FILENO, fileno);
|
||||
out = fdopen(sexp_fileno_fd(fileno), "w");
|
||||
if (!out) return sexp_user_exception(ctx, SEXP_FALSE, "couldn't open fileno", fileno);
|
||||
res = sexp_make_output_port(ctx, out, SEXP_FALSE);
|
||||
if (!sexp_exceptionp(res)) sexp_port_shutdownp(res) = sexp_truep(shutdownp);
|
||||
return res;
|
||||
}
|
||||
|
||||
#else /* ! SEXP_USE_STRING_STREAMS */
|
||||
|
||||
#define SEXP_PORT_BUFFER_SIZE 4096
|
||||
|
|
@ -1338,7 +1368,7 @@ int sexp_buffered_read_char (sexp ctx, sexp p) {
|
|||
res = ((sexp_port_offset(p) < sexp_port_size(p))
|
||||
? sexp_port_buf(p)[sexp_port_offset(p)++] : EOF);
|
||||
}
|
||||
} else if (sexp_filenop(sexp_port_fd(p)) && sexp_not(sexp_port_cookie(p))) {
|
||||
} else if (sexp_filenop(sexp_port_fd(p))) {
|
||||
res = read(sexp_port_fileno(p), sexp_port_buf(p), SEXP_PORT_BUFFER_SIZE);
|
||||
if (res >= 0) {
|
||||
sexp_port_offset(p) = 0;
|
||||
|
|
@ -1367,15 +1397,16 @@ int sexp_buffered_write_string_n (sexp ctx, const char *str,
|
|||
while (sexp_port_offset(p)+len >= sexp_port_size(p)) {
|
||||
diff = sexp_port_size(p) - sexp_port_offset(p);
|
||||
memcpy(sexp_port_buf(p)+sexp_port_offset(p), str, diff);
|
||||
sexp_port_offset(p) = sexp_port_size(p);
|
||||
if ((res = sexp_buffered_flush(ctx, p)))
|
||||
return written;
|
||||
written += diff;
|
||||
return written + diff;
|
||||
written += sexp_port_size(p);
|
||||
str += diff;
|
||||
len -= diff;
|
||||
}
|
||||
memcpy(sexp_port_buf(p)+sexp_port_offset(p), str, len);
|
||||
sexp_port_offset(p) += len;
|
||||
return 0;
|
||||
return written + len;
|
||||
}
|
||||
|
||||
int sexp_buffered_write_string (sexp ctx, const char *str, sexp p) {
|
||||
|
|
@ -1383,26 +1414,38 @@ int sexp_buffered_write_string (sexp ctx, const char *str, sexp p) {
|
|||
}
|
||||
|
||||
int sexp_buffered_flush (sexp ctx, sexp p) {
|
||||
int res;
|
||||
long res = 0, off;
|
||||
sexp_gc_var1(tmp);
|
||||
if (! (sexp_oportp(p) && sexp_port_openp(p)))
|
||||
return -1;
|
||||
off = sexp_port_offset(p);
|
||||
if (sexp_port_stream(p)) {
|
||||
fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p));
|
||||
if (off > 0) fwrite(sexp_port_buf(p), 1, off, sexp_port_stream(p));
|
||||
res = fflush(sexp_port_stream(p));
|
||||
} else if (sexp_filenop(sexp_port_fd(p))) {
|
||||
res = write(sexp_fileno_fd(sexp_port_fd(p)), sexp_port_buf(p), sexp_port_offset(p));
|
||||
} else if (sexp_port_offset(p) > 0) {
|
||||
sexp_gc_preserve1(ctx, tmp);
|
||||
tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p));
|
||||
res = 0;
|
||||
if (tmp && sexp_stringp(tmp))
|
||||
sexp_push(ctx, sexp_port_cookie(p), tmp);
|
||||
else
|
||||
res = write(sexp_fileno_fd(sexp_port_fd(p)), sexp_port_buf(p), off);
|
||||
if (res < off) {
|
||||
if (res > 0) {
|
||||
memmove(sexp_port_buf(p), sexp_port_buf(p) + res, off - res);
|
||||
sexp_port_offset(p) = off - res;
|
||||
}
|
||||
res = -1;
|
||||
} else {
|
||||
sexp_port_offset(p) = 0;
|
||||
res = 0;
|
||||
}
|
||||
} else if (sexp_port_offset(p) > 0) { /* string port */
|
||||
sexp_gc_preserve1(ctx, tmp);
|
||||
tmp = sexp_c_string(ctx, sexp_port_buf(p), off);
|
||||
if (tmp && sexp_stringp(tmp)) {
|
||||
sexp_push(ctx, sexp_port_cookie(p), tmp);
|
||||
sexp_port_offset(p) = 0;
|
||||
res = 0;
|
||||
} else {
|
||||
res = -1;
|
||||
}
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
if (res == 0) sexp_port_offset(p) = 0;
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -1416,7 +1459,6 @@ sexp sexp_make_input_string_port_op (sexp ctx, sexp self, sexp_sint_t n, sexp st
|
|||
sexp_port_offset(res) = 0;
|
||||
sexp_port_size(res) = sexp_string_length(str);
|
||||
sexp_port_binaryp(res) = 0;
|
||||
sexp_port_cookie(res) = SEXP_TRUE;
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -1446,6 +1488,7 @@ sexp sexp_get_output_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp out) {
|
|||
} else {
|
||||
ls = sexp_port_cookie(out);
|
||||
}
|
||||
res = SEXP_FALSE;
|
||||
for (tmp = ls; sexp_pairp(tmp); tmp = sexp_cdr(tmp))
|
||||
if (!sexp_stringp(sexp_car(tmp)))
|
||||
res = sexp_xtype_exception(ctx, self, "not an output string port", out);
|
||||
|
|
@ -1457,13 +1500,41 @@ sexp sexp_get_output_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp out) {
|
|||
return res;
|
||||
}
|
||||
|
||||
#endif
|
||||
sexp sexp_open_input_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp fileno, sexp shutdownp) {
|
||||
sexp_gc_var2(res, str);
|
||||
sexp_assert_type(ctx, sexp_filenop, SEXP_FILENO, fileno);
|
||||
if (sexp_unbox_fixnum(fileno) < 0)
|
||||
return sexp_user_exception(ctx, self, "invalid file descriptor", fileno);
|
||||
sexp_gc_preserve2(ctx, res, str);
|
||||
str = sexp_make_string(ctx, sexp_make_fixnum(SEXP_PORT_BUFFER_SIZE), SEXP_VOID);
|
||||
res = sexp_make_input_string_port(ctx, str);
|
||||
if (!sexp_exceptionp(res)) {
|
||||
sexp_port_fd(res) = fileno;
|
||||
sexp_port_offset(res) = SEXP_PORT_BUFFER_SIZE;
|
||||
sexp_port_shutdownp(res) = sexp_truep(shutdownp);
|
||||
}
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_make_fileno (sexp ctx, int fd, int socketp) {
|
||||
sexp res = sexp_alloc_type(ctx, fileno, SEXP_FILENO);
|
||||
sexp sexp_open_output_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp fileno, sexp shutdownp) {
|
||||
sexp res = sexp_open_input_file_descriptor(ctx, self, n, fileno, shutdownp);
|
||||
if (!sexp_exceptionp(res)) {
|
||||
sexp_pointer_tag(res) = SEXP_OPORT;
|
||||
sexp_port_offset(res) = 0;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
#endif /* ! SEXP_USE_STRING_STREAMS */
|
||||
|
||||
sexp sexp_make_fileno (sexp ctx, int fd, int no_closep) {
|
||||
sexp res;
|
||||
if (fd < 0) return SEXP_FALSE;
|
||||
res = sexp_alloc_type(ctx, fileno, SEXP_FILENO);
|
||||
if (!sexp_exceptionp(res)) {
|
||||
sexp_fileno_fd(res) = fd;
|
||||
sexp_fileno_socketp(res) = socketp;
|
||||
sexp_fileno_no_closep(res) = no_closep;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
|
@ -1480,6 +1551,7 @@ sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) {
|
|||
sexp_port_openp(p) = 1;
|
||||
sexp_port_bidirp(p) = 0;
|
||||
sexp_port_binaryp(p) = 1;
|
||||
sexp_port_shutdownp(p) = 0;
|
||||
sexp_port_no_closep(p) = 0;
|
||||
sexp_port_sourcep(p) = 0;
|
||||
sexp_port_blockedp(p) = 0;
|
||||
|
|
|
|||
28
vm.c
28
vm.c
|
|
@ -1780,7 +1780,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
i = sexp_write_char(ctx, sexp_unbox_character(_ARG1), _ARG2);
|
||||
if (i == EOF) {
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
if (sexp_port_stream(_ARG2) /* && ferror(sexp_port_stream(_ARG2)) */
|
||||
if ((sexp_port_stream(_ARG2) ? ferror(sexp_port_stream(_ARG2)) : 1)
|
||||
&& (errno == EAGAIN)
|
||||
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
|
||||
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG2));
|
||||
|
|
@ -1817,24 +1817,13 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
if (! sexp_oportp(_ARG3))
|
||||
sexp_raise("write-string: not an output-port", sexp_list1(ctx, _ARG3));
|
||||
sexp_context_top(ctx) = top;
|
||||
if (sexp_port_stream(_ARG3) && sexp_port_fileno(_ARG3) >= 0) {
|
||||
/* first flush anything pending */
|
||||
i = fflush(sexp_port_stream(_ARG3));
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
if (i) {
|
||||
i = 0;
|
||||
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG3));
|
||||
if (errno == EAGAIN)
|
||||
goto write_string_yield;
|
||||
}
|
||||
errno = 0;
|
||||
/* fwrite doesn't give reliable counts, use write(2) directly */
|
||||
i = write(sexp_port_fileno(_ARG3), sexp_bytes_data(tmp1), sexp_unbox_fixnum(_ARG2));
|
||||
#else
|
||||
i = fwrite(sexp_bytes_data(tmp1), 1, sexp_unbox_fixnum(_ARG2), sexp_port_stream(_ARG3));
|
||||
#endif
|
||||
i = sexp_write_string_n(ctx, sexp_bytes_data(tmp1), sexp_unbox_fixnum(_ARG2), _ARG3);
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
if (i < sexp_unbox_fixnum(_ARG2)) {
|
||||
if (sexp_port_stream(_ARG3)) clearerr(sexp_port_stream(_ARG3));
|
||||
/* modify stack in-place so we continue where we left off next time */
|
||||
if (i > 0) {
|
||||
if (sexp_stringp(_ARG1))
|
||||
|
|
@ -1844,7 +1833,6 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
_ARG2 = sexp_make_fixnum(sexp_unbox_fixnum(_ARG2) - i);
|
||||
}
|
||||
/* yield if threads are enabled (otherwise busy loop) */
|
||||
write_string_yield:
|
||||
if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
|
||||
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG3);
|
||||
fuel = 0;
|
||||
|
|
@ -1853,12 +1841,6 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
goto loop;
|
||||
}
|
||||
#endif
|
||||
} else { /* not a stream-backed string, won't block */
|
||||
if (sexp_bytes_length(tmp1) != sexp_unbox_fixnum(_ARG2))
|
||||
tmp1 = sexp_subbytes(ctx, tmp1, SEXP_ZERO, _ARG2);
|
||||
sexp_write_string(ctx, sexp_bytes_data(tmp1), _ARG3);
|
||||
i = sexp_unbox_fixnum(_ARG2);
|
||||
}
|
||||
tmp1 = sexp_make_fixnum(i); /* return the number of bytes written */
|
||||
top-=2;
|
||||
_ARG1 = tmp1;
|
||||
|
|
@ -1878,7 +1860,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
#endif
|
||||
if (i == EOF) {
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
if (sexp_port_stream(_ARG1) /* && ferror(sexp_port_stream(_ARG1)) */
|
||||
if ((sexp_port_stream(_ARG1) ? ferror(sexp_port_stream(_ARG1)) : 1)
|
||||
&& (errno == EAGAIN)
|
||||
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
|
||||
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG1));
|
||||
|
|
@ -1903,7 +1885,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
i = sexp_read_char(ctx, _ARG1);
|
||||
if (i == EOF) {
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
if (sexp_port_stream(_ARG1) /* && ferror(sexp_port_stream(_ARG1)) */
|
||||
if ((sexp_port_stream(_ARG1) ? ferror(sexp_port_stream(_ARG1)) : 1)
|
||||
&& (errno == EAGAIN)
|
||||
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
|
||||
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG1));
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue