mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 14:19:18 +02:00
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.
This commit is contained in:
Alex Shinn
parent
380a551f43
commit
1dd61a26f3
8 changed files with 68 additions and 17 deletions
7
eval.c
7
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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])}}
|
||||
|
|
|
|||
15
sexp.c
15
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));
|
||||
|
|
|
|||
|
|
@ -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*))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue