From 1dd61a26f35d70a85ee213de3044188c0413fe4e Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 5 Jan 2012 23:39:00 +0900 Subject: [PATCH] Adding support for bi-directional ports, and making (chibi net) use them for sockets. Also modifying FFI to automatically make input ports non-blocking, and fixing R7RS incompatibility where closing an already closed port signalled an error. --- eval.c | 7 ++++--- include/chibi/features.h | 6 +++++- include/chibi/sexp.h | 12 +++++++++--- lib/chibi/filesystem.sld | 1 + lib/chibi/filesystem.stub | 7 ++++++- lib/chibi/net.scm | 14 ++++++++++---- sexp.c | 15 ++++++++++++++- tools/chibi-ffi | 23 +++++++++++++++++++---- 8 files changed, 68 insertions(+), 17 deletions(-) diff --git a/eval.c b/eval.c index b165eb45..a418cd0f 100644 --- a/eval.c +++ b/eval.c @@ -1,5 +1,5 @@ /* eval.c -- evaluator library implementation */ -/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ #include "chibi/eval.h" @@ -1050,8 +1050,6 @@ sexp sexp_open_binary_output_file (sexp ctx, sexp self, sexp_sint_t n, sexp path sexp sexp_close_port_op (sexp ctx, sexp self, sexp_sint_t n, sexp port) { sexp_assert_type(ctx, sexp_portp, SEXP_OPORT, port); - if (! sexp_port_openp(port)) - return sexp_user_exception(ctx, self, "port already closed", port); return sexp_finalize_port(ctx, self, n, port); } @@ -1964,6 +1962,9 @@ static const char* sexp_initial_features[] = { #if SEXP_USE_DL "dynamic-loading", #endif +#if SEXP_USE_BIDIRECTIONAL_PORTS + "bidir-ports", +#endif #if SEXP_USE_STRING_STREAMS "string-streams", #endif diff --git a/include/chibi/features.h b/include/chibi/features.h index 0846d313..5f0da353 100644 --- a/include/chibi/features.h +++ b/include/chibi/features.h @@ -1,5 +1,5 @@ /* features.h -- general feature configuration */ -/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ /* uncomment this to disable most features */ @@ -510,6 +510,10 @@ #define SEXP_USE_GC_FILE_DESCRIPTORS (SEXP_USE_AUTOCLOSE_PORTS &&!SEXP_USE_BOEHM && !defined(PLAN9)) #endif +#ifndef SEXP_USE_BIDIRECTIONAL_PORTS +#define SEXP_USE_BIDIRECTIONAL_PORTS ! SEXP_USE_NO_FEATURES +#endif + #ifndef SEXP_USE_2010_EPOCH #define SEXP_USE_2010_EPOCH ! SEXP_USE_NO_FEATURES #endif diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 7783a04b..8e966a4c 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -1,5 +1,5 @@ /* sexp.h -- header for sexp library */ -/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ #ifndef SEXP_H @@ -315,7 +315,7 @@ struct sexp_struct { struct { FILE *stream; char *buf; - char openp, binaryp, no_closep, sourcep, blockedp, fold_casep; + char openp, bidirp, binaryp, no_closep, sourcep, blockedp, fold_casep; sexp_uint_t offset, line, flags; size_t size; sexp name; @@ -604,7 +604,11 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_bytesp(x) (sexp_check_tag(x, SEXP_BYTES)) #define sexp_vectorp(x) (sexp_check_tag(x, SEXP_VECTOR)) #define sexp_iportp(x) (sexp_check_tag(x, SEXP_IPORT)) +#if SEXP_USE_BIDIRECTIONAL_PORTS +#define sexp_oportp(x) (sexp_check_tag(x, SEXP_OPORT) || (sexp_check_tag(x, SEXP_IPORT) && sexp_port_bidirp(x))) +#else #define sexp_oportp(x) (sexp_check_tag(x, SEXP_OPORT)) +#endif #if SEXP_USE_BIGNUMS #define sexp_bignump(x) (sexp_check_tag(x, SEXP_BIGNUM)) #else @@ -651,7 +655,7 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_idp(x) \ (sexp_symbolp(x) || (sexp_synclop(x) && sexp_symbolp(sexp_synclo_expr(x)))) -#define sexp_portp(x) (sexp_iportp(x) || sexp_oportp(x)) +#define sexp_portp(x) (sexp_check_tag(x, SEXP_IPORT) || sexp_check_tag(x, SEXP_OPORT)) #if SEXP_USE_STRING_STREAMS #define sexp_stream_portp(x) 1 @@ -842,6 +846,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x); #define sexp_port_name(p) (sexp_pred_field(p, port, sexp_portp, name)) #define sexp_port_line(p) (sexp_pred_field(p, port, sexp_portp, line)) #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_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)) @@ -1248,6 +1253,7 @@ 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_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); SEXP_API sexp sexp_port_binaryp_op (sexp ctx, sexp self, sexp_sint_t n, sexp port); SEXP_API sexp sexp_port_openp_op (sexp ctx, sexp self, sexp_sint_t n, sexp port); #if SEXP_USE_FOLD_CASE_SYMS diff --git a/lib/chibi/filesystem.sld b/lib/chibi/filesystem.sld index 735f6ef7..09ccdda4 100644 --- a/lib/chibi/filesystem.sld +++ b/lib/chibi/filesystem.sld @@ -6,6 +6,7 @@ (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 close-file-descriptor renumber-file-descriptor delete-file link-file symbolic-link-file rename-file diff --git a/lib/chibi/filesystem.stub b/lib/chibi/filesystem.stub index f934779c..cb8475a8 100644 --- a/lib/chibi/filesystem.stub +++ b/lib/chibi/filesystem.stub @@ -1,5 +1,5 @@ ;; filesystem.stub -- filesystem bindings -;; Copyright (c) 2009-2011 Alex Shinn. All rights reserved. +;; Copyright (c) 2009-2012 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt (c-system-include "sys/types.h") @@ -75,6 +75,11 @@ (define-c output-port (open-output-file-descriptor "fdopen") (int (value "w" string))) +;;> Creates a new bidirectional port from the file descriptor @var{int}. + +(define-c input-output-port (open-input-output-file-descriptor "fdopen") + (int (value "r+" string))) + ;;> Unlinks the file named @var{string} from the filesystem. ;;> Returns @scheme{#t} on success and @scheme{#f} on failure. diff --git a/lib/chibi/net.scm b/lib/chibi/net.scm index c3df676b..22ec51b7 100644 --- a/lib/chibi/net.scm +++ b/lib/chibi/net.scm @@ -1,4 +1,4 @@ -;; Copyright (c) 2010-2011 Alex Shinn. All rights reserved. +;; Copyright (c) 2010-2012 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt ;;> @subsubsubsection{@scheme{(get-address-info host service [addrinfo])}} @@ -42,8 +42,13 @@ (cond-expand (threads (set-file-descriptor-flags! sock open/non-block)) (else #f)) - (list (open-input-file-descriptor sock) - (open-output-file-descriptor sock))))))))) + (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))))))))))) ;;> Convenience wrapper around @scheme{open-net-io}, opens ;;> the connection then calls @var{proc} with two arguments, @@ -56,8 +61,9 @@ (let ((io (open-net-io host service))) (if (not (pair? io)) (error "couldn't find address" host service) - (let ((res (proc (car io) (car (cdr io))))) + (let ((res (proc (car io) (cadr io)))) (close-input-port (car io)) + (close-output-port (cadr io)) res)))) ;;> @subsubsubsection{@scheme{(make-listener-socket addrinfo [max-conn])}} diff --git a/sexp.c b/sexp.c index e292cb4b..7d4a38b8 100644 --- a/sexp.c +++ b/sexp.c @@ -1,5 +1,5 @@ /* sexp.c -- standalone sexp library implementation */ -/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ #include "chibi/sexp.h" @@ -1390,6 +1390,7 @@ sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) { sexp_port_flags(p) = SEXP_PORT_UNKNOWN_FLAGS; sexp_port_buf(p) = NULL; sexp_port_openp(p) = 1; + sexp_port_bidirp(p) = 0; sexp_port_binaryp(p) = 1; sexp_port_no_closep(p) = 0; sexp_port_sourcep(p) = 0; @@ -1418,6 +1419,18 @@ sexp sexp_make_non_null_output_port (sexp ctx, FILE* out, sexp name) { return sexp_make_output_port(ctx, out, name); } +#if SEXP_USE_BIDIRECTIONAL_PORTS +sexp sexp_make_non_null_input_output_port (sexp ctx, FILE* io, sexp name) { + sexp res; + if (!io) return sexp_user_exception(ctx, SEXP_FALSE, "null input-output-port", name); + res = sexp_make_input_port(ctx, io, name); + if (sexp_portp(res)) sexp_port_bidirp(res) = 1; + return res; +} +#else +#define sexp_make_non_null_input_output_port sexp_make_non_null_input_port +#endif + sexp sexp_port_binaryp_op (sexp ctx, sexp self, sexp_sint_t n, sexp port) { sexp_assert_type(ctx, sexp_portp, SEXP_IPORT, port); return sexp_make_boolean(sexp_port_binaryp(port)); diff --git a/tools/chibi-ffi b/tools/chibi-ffi index 587e3015..36fa974b 100755 --- a/tools/chibi-ffi +++ b/tools/chibi-ffi @@ -149,7 +149,7 @@ (eq? 'char (type-base type))))) (define (port-type? type) - (memq type '(port input-port output-port))) + (memq type '(port input-port output-port input-output-port))) (define (error-type? type) (memq type '(errno non-null-string non-null-pointer))) @@ -400,6 +400,7 @@ ((eq? base 'port) "sexp_portp") ((eq? base 'input-port) "sexp_iportp") ((eq? base 'output-port) "sexp_oportp") + ((eq? base 'input-output-port) "sexp_ioportp") (else #f)))) (define (type-name type) @@ -424,6 +425,7 @@ ((eq? base 'port) "SEXP_IPORT") ((eq? base 'input-port) "SEXP_IPORT") ((eq? base 'output-port) "SEXP_OPORT") + ((eq? base 'input-output-port) "SEXP_IPORT") ((void-pointer-type? type) "SEXP_CPOINTER") ((assq base *types*) ;; (string-append "sexp_type_tag(" (type-id-name base) ")") @@ -495,6 +497,8 @@ (cat "sexp_make_non_null_input_port(ctx, " val ", SEXP_FALSE)")) ((eq? 'output-port base) (cat "sexp_make_non_null_output_port(ctx, " val ", SEXP_FALSE)")) + ((eq? 'input-output-port base) + (cat "sexp_make_non_null_input_output_port(ctx, " val ", SEXP_FALSE)")) (else (let ((ctype (assq base *types*)) (void*? (void-pointer-type? type))) @@ -895,7 +899,17 @@ (else #f))) (cat ";\n") (if (type-array ret-type) - (write-result ret-type)))) + (write-result ret-type) + (write-result-adjustment ret-type)))) + +(define (write-result-adjustment result) + (cond + ((memq (type-base result) '(input-port input-output-port)) + (let ((res (string-append "res" (type-index-string result)))) + (cat "#ifdef SEXP_USE_GREEN_THREADS\n" + " if (sexp_portp(" res "))\n" + " fcntl(fileno(sexp_port_stream(" res ")), F_SETFL, O_NONBLOCK);\n" + "#endif\n"))))) (define (write-result result) (let ((res (string-append "res" (type-index-string result))) @@ -934,7 +948,8 @@ (c->scheme-converter result (string-append "tmp" (type-index-string result))) - (cat ";\n"))))) + (cat ";\n"))) + (write-result-adjustment result))) (define (write-results func) (let ((error-res? (error-type? (type-base (func-ret-type func)))) @@ -998,7 +1013,7 @@ (if (number? len) (cat " if (len" i " != " len ")\n" " free(tmp" i ");\n")))) - ((eq? (type-base a) 'input-port) + ((memq (type-base a) '(input-port input-output-port)) (cat " sexp_maybe_unblock_port(ctx, arg" (type-index a) ");\n")) ((and (type-result? a) (not (basic-type? a)) (not (assq (type-base a) *types*))