diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 62097f1e..e6693076 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -1159,6 +1159,7 @@ enum sexp_context_globals { SEXP_G_ABI_ERROR, /* incompatible ABI loading library */ SEXP_G_OPTIMIZATIONS, SEXP_G_SIGNAL_HANDLERS, + SEXP_G_FILE_DESCRIPTORS, SEXP_G_META_ENV, SEXP_G_MODULE_PATH, SEXP_G_QUOTE_SYMBOL, @@ -1306,7 +1307,7 @@ 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 no_closep); +SEXP_API sexp sexp_make_fileno_op (sexp ctx, sexp self, sexp_sint_t n, sexp fd, sexp 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); @@ -1444,6 +1445,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj #define sexp_make_getter(ctx, a, b, c) sexp_make_getter_op(ctx, NULL, 3, a, b, c) #define sexp_make_setter(ctx, a, b, c) sexp_make_setter_op(ctx, NULL, 3, a, b, c) #define sexp_lookup_type(ctx, name, id) sexp_lookup_type_op(ctx, NULL, 2, name, id) +#define sexp_make_fileno(ctx, fd, no_closep) sexp_make_fileno_op(ctx, NULL, 2, fd, no_closep) enum sexp_opcode_names { SEXP_OP_NOOP, diff --git a/lib/chibi/accept.c b/lib/chibi/accept.c index d6970e57..a93e613c 100644 --- a/lib/chibi/accept.c +++ b/lib/chibi/accept.c @@ -19,7 +19,7 @@ sexp sexp_accept (sexp ctx, sexp self, int sock, struct sockaddr* addr, socklen_ } } #endif - return sexp_make_fileno(ctx, res, 0); + return sexp_make_fileno(ctx, sexp_make_fixnum(res), SEXP_FALSE); } /* If we're listening on a socket from Scheme, we most likely want it */ diff --git a/lib/chibi/process.scm b/lib/chibi/process.scm index 040dbf21..b4221824 100644 --- a/lib/chibi/process.scm +++ b/lib/chibi/process.scm @@ -49,23 +49,6 @@ (else (waitpid pid 0))))) -(define (string-char-index str c . o) - (let ((start (if (pair? o) (car o) 0)) - (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str)))) - (let lp ((i start)) - (cond - ((= i end) #f) - ((eq? c (string-ref str i)) i) - (else (lp (+ i 1))))))) - -(define (string-split str ch) - (let ((len (string-length str))) - (let lp ((i 0) (res '())) - (let ((j (string-char-index str ch i))) - (if j - (lp (+ j 1) (cons (substring str i j) res)) - (reverse (cons (substring str i len) res))))))) - (define (call-with-process-io command proc) (let ((command-ls (if (string? command) (string-split command) command)) (in-pipe (open-pipe)) diff --git a/lib/chibi/process.sld b/lib/chibi/process.sld index 641a4e56..03364555 100644 --- a/lib/chibi/process.sld +++ b/lib/chibi/process.sld @@ -16,7 +16,7 @@ signal/tty-output wait/no-hang call-with-process-io process->string process->string-list process->output+error) - (import (scheme) (chibi io) (chibi filesystem)) + (import (scheme) (chibi io) (chibi strings) (chibi filesystem)) (cond-expand (threads (import (srfi 18))) (else #f)) (include-shared "process") (include "process.scm")) diff --git a/sexp.c b/sexp.c index 823eb105..ae681b1c 100644 --- a/sexp.c +++ b/sexp.c @@ -1553,13 +1553,14 @@ sexp sexp_open_output_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp #endif /* ! SEXP_USE_STRING_STREAMS */ -sexp sexp_make_fileno (sexp ctx, int fd, int no_closep) { +sexp sexp_make_fileno_op (sexp ctx, sexp self, sexp_sint_t n, sexp fd, sexp no_closep) { sexp res; - if (fd < 0) return SEXP_FALSE; + sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, fd); + if (sexp_unbox_fixnum(fd) < 0) return SEXP_FALSE; res = sexp_alloc_type(ctx, fileno, SEXP_FILENO); if (!sexp_exceptionp(res)) { - sexp_fileno_fd(res) = fd; - sexp_fileno_no_closep(res) = no_closep; + sexp_fileno_fd(res) = sexp_unbox_fixnum(fd); + sexp_fileno_no_closep(res) = sexp_truep(no_closep); } return res; } diff --git a/tools/chibi-ffi b/tools/chibi-ffi index ebd356b6..ac6953cf 100755 --- a/tools/chibi-ffi +++ b/tools/chibi-ffi @@ -607,7 +607,7 @@ ((eq? 'input-output-port base) (cat "sexp_make_non_null_input_output_port(ctx, " val ", SEXP_FALSE)")) ((eq? 'fileno base) - (cat "sexp_make_fileno(ctx, " val ", 0)")) + (cat "sexp_make_fileno(ctx, sexp_make_fixnum(" val "), SEXP_FALSE)")) (else (let ((ctype (lookup-type base)) (void*? (void-pointer-type? type))) @@ -656,7 +656,8 @@ ((port-type? base) (cat "sexp_port_stream(" val ")")) ((eq? base 'fileno) - (cat "sexp_fileno_fd(" val ")")) + (cat "(sexp_filenop(" val ") ? sexp_fileno_fd(" val ")" + " : sexp_unbox_fixnum(" val "))")) (else (let ((ctype (lookup-type base)) (void*? (void-pointer-type? type))) @@ -711,8 +712,10 @@ ((eq? base 'env-string) (cat "(sexp_pairp(" arg ") && sexp_stringp(sexp_car(" arg ")) && sexp_stringp(sexp_cdr(" arg ")))")) + ((eq? base 'fileno) + (cat "(sexp_filenop(" arg ") || sexp_fixnump(" arg "))")) ((or (int-type? base) (float-type? base) - (string-type? base) (port-type? base) (eq? base 'fileno)) + (string-type? base) (port-type? base)) (cat (type-predicate type) "(" arg ")")) ((or (lookup-type base) (void-pointer-type? type)) (cat