mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 22:29:16 +02:00
switching to first-class file descriptor type
This commit is contained in:
Alex Shinn
parent
94037929be
commit
7c8203ed0a
9 changed files with 148 additions and 56 deletions
|
|
@ -64,8 +64,9 @@ typedef unsigned long size_t;
|
|||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdarg.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/socket.h>
|
||||
#include <sys/stat.h>
|
||||
#include <sys/types.h>
|
||||
#include <math.h>
|
||||
#if SEXP_USE_FLONUMS
|
||||
#include <float.h>
|
||||
|
|
@ -132,6 +133,7 @@ enum sexp_types {
|
|||
#endif
|
||||
SEXP_IPORT,
|
||||
SEXP_OPORT,
|
||||
SEXP_FILENO,
|
||||
SEXP_EXCEPTION,
|
||||
SEXP_PROCEDURE,
|
||||
SEXP_MACRO,
|
||||
|
|
@ -327,7 +329,12 @@ struct sexp_struct {
|
|||
size_t size;
|
||||
sexp name;
|
||||
sexp cookie;
|
||||
sexp fd;
|
||||
} port;
|
||||
struct {
|
||||
char openp, socketp, no_closep;
|
||||
sexp_sint_t fd;
|
||||
} fileno;
|
||||
struct {
|
||||
sexp kind, message, irritants, procedure, source;
|
||||
} exception;
|
||||
|
|
@ -618,6 +625,7 @@ sexp sexp_make_flonum(sexp ctx, double f);
|
|||
#else
|
||||
#define sexp_oportp(x) (sexp_check_tag(x, SEXP_OPORT))
|
||||
#endif
|
||||
#define sexp_filenop(x) (sexp_check_tag(x, SEXP_FILENO))
|
||||
#if SEXP_USE_BIGNUMS
|
||||
#define sexp_bignump(x) (sexp_check_tag(x, SEXP_BIGNUM))
|
||||
#else
|
||||
|
|
@ -866,6 +874,12 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
|
|||
#define sexp_port_size(p) (sexp_pred_field(p, port, sexp_portp, size))
|
||||
#define sexp_port_offset(p) (sexp_pred_field(p, port, sexp_portp, offset))
|
||||
#define sexp_port_flags(p) (sexp_pred_field(p, port, sexp_portp, flags))
|
||||
#define sexp_port_fd(p) (sexp_pred_field(p, port, sexp_portp, fd))
|
||||
|
||||
#define sexp_fileno_fd(f) (sexp_pred_field(f, fileno, sexp_filenop, fd))
|
||||
#define sexp_fileno_openp(f) (sexp_pred_field(f, fileno, sexp_filenop, openp))
|
||||
#define sexp_fileno_socketp(f) (sexp_pred_field(f, fileno, sexp_filenop, socketp))
|
||||
#define sexp_fileno_no_closep(f) (sexp_pred_field(f, fileno, sexp_filenop, no_closep))
|
||||
|
||||
#define sexp_ratio_numerator(q) (sexp_pred_field(q, ratio, sexp_ratiop, numerator))
|
||||
#define sexp_ratio_denominator(q) (sexp_pred_field(q, ratio, sexp_ratiop, denominator))
|
||||
|
|
@ -1219,7 +1233,7 @@ SEXP_API int sexp_buffered_flush (sexp ctx, sexp p);
|
|||
|
||||
#define sexp_newline(ctx, p) sexp_write_char((ctx), '\n', (p))
|
||||
#define sexp_at_eofp(p) (feof(sexp_port_stream(p)))
|
||||
#define sexp_port_fileno(p) (fileno(sexp_port_stream(p)))
|
||||
#define sexp_port_fileno(p) (sexp_port_stream(p) ? fileno(sexp_port_stream(p)) : sexp_filenop(sexp_port_fd(p)) ? sexp_fileno_fd(sexp_port_fd(p)) : -1)
|
||||
|
||||
#if SEXP_USE_TRACK_ALLOC_SOURCE
|
||||
#define sexp_current_source_param , const char* source
|
||||
|
|
@ -1270,6 +1284,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 socketp);
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ sexp sexp_accept (sexp ctx, sexp self, int sock, struct sockaddr* addr, socklen_
|
|||
}
|
||||
}
|
||||
#endif
|
||||
return sexp_make_integer(ctx, res);
|
||||
return sexp_make_fileno(ctx, res, 1);
|
||||
}
|
||||
|
||||
/* If we're listening on a socket from Scheme, we most likely want it */
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
|
||||
(define-library (chibi filesystem)
|
||||
(export open-input-file-descriptor open-output-file-descriptor
|
||||
open-input-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
|
||||
|
|
|
|||
|
|
@ -68,17 +68,17 @@
|
|||
;;> Creates a new input-port from the file descriptor @var{int}.
|
||||
|
||||
(define-c input-port (open-input-file-descriptor "fdopen")
|
||||
(int (value "r" string)))
|
||||
(fileno (value "r" string)))
|
||||
|
||||
;;> Creates a new output-port from the file descriptor @var{int}.
|
||||
|
||||
(define-c output-port (open-output-file-descriptor "fdopen")
|
||||
(int (value "w" string)))
|
||||
(fileno (value "w" string)))
|
||||
|
||||
;;> Creates a new bidirectional port from the file descriptor @var{int}.
|
||||
;; 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)))
|
||||
;; (define-c input-output-port (open-input-output-file-descriptor "fdopen")
|
||||
;; (fileno (value "r+" string)))
|
||||
|
||||
;;> Unlinks the file named @var{string} from the filesystem.
|
||||
;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
|
||||
|
|
@ -122,27 +122,27 @@
|
|||
;;> Duplicates the given file descriptor, returning he new value,
|
||||
;; or -1 on failure.
|
||||
|
||||
(define-c int (duplicate-file-descriptor "dup") (int))
|
||||
(define-c fileno (duplicate-file-descriptor "dup") (fileno))
|
||||
|
||||
;;> Copies the first file descriptor to the second, closing
|
||||
;;> it if needed.
|
||||
;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
|
||||
|
||||
(define-c errno (duplicate-file-descriptor-to "dup2") (int int))
|
||||
(define-c errno (duplicate-file-descriptor-to "dup2") (fileno fileno))
|
||||
|
||||
;;> Closes the given file descriptor.
|
||||
;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
|
||||
|
||||
(define-c errno (close-file-descriptor "close") (int))
|
||||
(define-c errno (close-file-descriptor "close") (fileno))
|
||||
|
||||
;;> Opens the given file and returns a file descriptor.
|
||||
|
||||
(define-c int open (string int (default #o644 int)))
|
||||
(define-c fileno open (string int (default #o644 int)))
|
||||
|
||||
;;> Returns a list of 2 new file descriptors, the input and
|
||||
;;> output end of a new pipe, respectively.
|
||||
|
||||
(define-c errno (open-pipe "pipe") ((result (array int 2))))
|
||||
(define-c errno (open-pipe "pipe") ((result (array fileno 2))))
|
||||
|
||||
;;> Creates a new named pipe in the given path.
|
||||
;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
|
||||
|
|
@ -150,17 +150,17 @@
|
|||
(define-c errno (make-fifo "mkfifo") (string (default #o644 int)))
|
||||
|
||||
(define-c int (get-file-descriptor-flags "fcntl")
|
||||
(int (value F_GETFD int)))
|
||||
(fileno (value F_GETFD int)))
|
||||
(define-c errno (set-file-descriptor-flags! "fcntl")
|
||||
(int (value F_SETFD int) long))
|
||||
(fileno (value F_SETFD int) long))
|
||||
|
||||
;;> Get and set the flags for the given file descriptor.
|
||||
;;/
|
||||
|
||||
(define-c int (get-file-descriptor-status "fcntl")
|
||||
(int (value F_GETFL int)))
|
||||
(fileno (value F_GETFL int)))
|
||||
(define-c errno (set-file-descriptor-status! "fcntl")
|
||||
(int (value F_SETFL int) long))
|
||||
(fileno (value F_SETFL int) long))
|
||||
|
||||
;;> Get and set the status for the given file descriptor.
|
||||
;;/
|
||||
|
|
@ -187,4 +187,4 @@
|
|||
;;> Returns @scheme{#t} if the given port of file descriptor
|
||||
;;> if backed by a TTY object, and @scheme{#f} otherwise.
|
||||
|
||||
(define-c boolean (is-a-tty? "isatty") (port-or-fd))
|
||||
(define-c boolean (is-a-tty? "isatty") (port-or-fileno))
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@
|
|||
|
||||
;;> Bind a name to a socket.
|
||||
|
||||
(define-c errno bind (int sockaddr int))
|
||||
(define-c errno bind (fileno sockaddr int))
|
||||
|
||||
;;> Listen on a socket.
|
||||
|
||||
|
|
@ -38,15 +38,15 @@
|
|||
;;> Accept a connection on a socket.
|
||||
|
||||
(define-c sexp (accept "sexp_accept")
|
||||
((value ctx sexp) (value self sexp) int sockaddr int))
|
||||
((value ctx sexp) (value self sexp) fileno sockaddr int))
|
||||
|
||||
;;> Create an endpoint for communication.
|
||||
|
||||
(define-c int socket (int int int))
|
||||
(define-c fileno socket (int int int))
|
||||
|
||||
;;> Initiate a connection on a socket.
|
||||
|
||||
(define-c int connect (int sockaddr int))
|
||||
(define-c int connect (fileno sockaddr int))
|
||||
|
||||
(define-c-const int (address-family/unix "AF_UNIX"))
|
||||
(define-c-const int (address-family/inet "AF_INET"))
|
||||
|
|
@ -62,14 +62,14 @@
|
|||
(c-include "accept.c")
|
||||
|
||||
(define-c errno getsockopt
|
||||
(int int int (result int) (result (value (sizeof int) socklen_t))))
|
||||
(fileno int int (result int) (result (value (sizeof int) socklen_t))))
|
||||
|
||||
;;> Set an option for the given socket. For example, to make the
|
||||
;;> address reusable:
|
||||
;;> @scheme{(set-socket-option! sock level/socket socket-opt/reuseaddr 1)}
|
||||
|
||||
(define-c errno (set-socket-option! "setsockopt")
|
||||
(int int int (pointer int) (value (sizeof int) socklen_t)))
|
||||
(fileno int int (pointer int) (value (sizeof int) socklen_t)))
|
||||
|
||||
(define-c-const int (level/socket "SOL_SOCKET"))
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@
|
|||
(unsigned-short ws_row winsize-row)
|
||||
(unsigned-short ws_col winsize-col))
|
||||
|
||||
(define-c errno ioctl (port-or-fd unsigned-long (result winsize)))
|
||||
(define-c errno ioctl (port-or-fileno unsigned-long (result winsize)))
|
||||
|
||||
(define-c-const int TIOCGWINSZ)
|
||||
|
||||
|
|
@ -101,6 +101,6 @@
|
|||
;; (define-c-const unsigned-long VSTATUS)
|
||||
|
||||
(define-c errno (get-terminal-attributes "tcgetattr")
|
||||
(port-or-fd (result termios)))
|
||||
(port-or-fileno (result termios)))
|
||||
(define-c errno (set-terminal-attributes! "tcsetattr")
|
||||
(port-or-fd int termios))
|
||||
(port-or-fileno int termios))
|
||||
|
|
|
|||
84
sexp.c
84
sexp.c
|
|
@ -116,17 +116,41 @@ sexp sexp_finalize_port (sexp ctx, sexp self, sexp_sint_t n, sexp port) {
|
|||
sexp_port_openp(port) = 0;
|
||||
if (sexp_port_stream(port) && ! sexp_port_no_closep(port)) {
|
||||
fclose(sexp_port_stream(port));
|
||||
if (sexp_port_buf(port) && sexp_oportp(port))
|
||||
if (sexp_port_buf(port)
|
||||
&& (sexp_oportp(port)
|
||||
#if !SEXP_USE_STRING_STREAMS
|
||||
|| (sexp_iportp(port) && sexp_truep(sexp_port_cookie(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_iportp(port))
|
||||
shutdown(sexp_fileno_fd(sexp_port_fd(port)), SHUT_RD);
|
||||
if (sexp_oportp(port))
|
||||
shutdown(sexp_fileno_fd(sexp_port_fd(port)), SHUT_WR);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
return SEXP_VOID;
|
||||
}
|
||||
|
||||
sexp sexp_finalize_fileno (sexp ctx, sexp self, sexp_sint_t n, sexp fileno) {
|
||||
if (sexp_fileno_openp(fileno) && !sexp_fileno_no_closep(fileno)) {
|
||||
sexp_fileno_openp(fileno) = 0;
|
||||
close(sexp_fileno_fd(fileno));
|
||||
}
|
||||
return SEXP_VOID;
|
||||
}
|
||||
|
||||
#if SEXP_USE_AUTOCLOSE_PORTS
|
||||
#define SEXP_FINALIZE_PORT sexp_finalize_port
|
||||
#define SEXP_FINALIZE_FILENO sexp_finalize_fileno
|
||||
#else
|
||||
#define SEXP_FINALIZE_PORT NULL
|
||||
#define SEXP_FINALIZE_FILENO NULL
|
||||
#endif
|
||||
|
||||
#if SEXP_USE_DL
|
||||
|
|
@ -165,6 +189,7 @@ static struct sexp_type_struct _sexp_type_specs[] = {
|
|||
#endif
|
||||
{SEXP_IPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Input-Port", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, SEXP_FINALIZE_PORT},
|
||||
{SEXP_OPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Output-Port", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, SEXP_FINALIZE_PORT},
|
||||
{SEXP_FILENO, 0, 0, 0, 0, 0, sexp_sizeof(fileno), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"File-Descriptor", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, SEXP_FINALIZE_FILENO},
|
||||
{SEXP_EXCEPTION, sexp_offsetof(exception, kind), 6, 6, 0, 0, sexp_sizeof(exception), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Exception", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, (sexp)sexp_write_simple_object, NULL},
|
||||
{SEXP_PROCEDURE, sexp_offsetof(procedure, bc), 2, 2, 0, 0, sexp_sizeof(procedure), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Procedure", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, NULL},
|
||||
{SEXP_MACRO, sexp_offsetof(macro, proc), 3, 3, 0, 0, sexp_sizeof(macro), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Macro", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, NULL},
|
||||
|
|
@ -1302,33 +1327,49 @@ sexp sexp_get_output_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp port) {
|
|||
#define SEXP_PORT_BUFFER_SIZE 4096
|
||||
|
||||
int sexp_buffered_read_char (sexp ctx, sexp p) {
|
||||
int res = 0;
|
||||
if (sexp_port_offset(p) < sexp_port_size(p)) {
|
||||
return sexp_port_buf(p)[sexp_port_offset(p)++];
|
||||
} else if (! sexp_port_stream(p)) {
|
||||
return EOF;
|
||||
} else {
|
||||
sexp_port_size(p)
|
||||
= fread(sexp_port_buf(p), 1, SEXP_PORT_BUFFER_SIZE, sexp_port_stream(p));
|
||||
} else if (sexp_port_stream(p)) {
|
||||
res = fread(sexp_port_buf(p), 1, SEXP_PORT_BUFFER_SIZE, sexp_port_stream(p));
|
||||
if (res >= 0) {
|
||||
sexp_port_offset(p) = 0;
|
||||
return ((sexp_port_offset(p) < sexp_port_size(p))
|
||||
sexp_port_size(p) = res;
|
||||
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))) {
|
||||
res = read(sexp_port_fileno(p), sexp_port_buf(p), SEXP_PORT_BUFFER_SIZE);
|
||||
if (res >= 0) {
|
||||
sexp_port_offset(p) = 0;
|
||||
sexp_port_size(p) = res;
|
||||
res = ((sexp_port_offset(p) < sexp_port_size(p))
|
||||
? sexp_port_buf(p)[sexp_port_offset(p)++] : EOF);
|
||||
}
|
||||
} else {
|
||||
res = EOF;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
int sexp_buffered_write_char (sexp ctx, int c, sexp p) {
|
||||
int res;
|
||||
if (sexp_port_offset(p)+1 >= sexp_port_size(p))
|
||||
sexp_buffered_flush(ctx, p);
|
||||
if ((res = sexp_buffered_flush(ctx, p)))
|
||||
return res;
|
||||
sexp_port_buf(p)[sexp_port_offset(p)++] = c;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int sexp_buffered_write_string_n (sexp ctx, const char *str,
|
||||
sexp_uint_t len, sexp p) {
|
||||
int diff;
|
||||
int diff, res, written=0;
|
||||
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_buffered_flush(ctx, p);
|
||||
if ((res = sexp_buffered_flush(ctx, p)))
|
||||
return written;
|
||||
written += diff;
|
||||
str += diff;
|
||||
len -= diff;
|
||||
}
|
||||
|
|
@ -1349,16 +1390,19 @@ int sexp_buffered_flush (sexp ctx, sexp p) {
|
|||
if (sexp_port_stream(p)) {
|
||||
fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), 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 = -1;
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
sexp_port_offset(p) = 0;
|
||||
if (res == 0) sexp_port_offset(p) = 0;
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -1372,6 +1416,7 @@ 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;
|
||||
}
|
||||
|
||||
|
|
@ -1385,8 +1430,8 @@ sexp sexp_make_output_string_port_op (sexp ctx, sexp self, sexp_sint_t n) {
|
|||
sexp_port_size(res) = SEXP_PORT_BUFFER_SIZE;
|
||||
sexp_port_offset(res) = 0;
|
||||
sexp_port_cookie(res) = SEXP_NULL;
|
||||
}
|
||||
sexp_port_binaryp(res) = 0;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -1414,6 +1459,15 @@ sexp sexp_get_output_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp out) {
|
|||
|
||||
#endif
|
||||
|
||||
sexp sexp_make_fileno (sexp ctx, int fd, int socketp) {
|
||||
sexp res = sexp_alloc_type(ctx, fileno, SEXP_FILENO);
|
||||
if (!sexp_exceptionp(res)) {
|
||||
sexp_fileno_fd(res) = fd;
|
||||
sexp_fileno_socketp(res) = socketp;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) {
|
||||
sexp p = sexp_alloc_type(ctx, port, SEXP_IPORT);
|
||||
if (sexp_exceptionp(p)) return p;
|
||||
|
|
@ -1422,6 +1476,7 @@ sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) {
|
|||
sexp_port_line(p) = 1;
|
||||
sexp_port_flags(p) = SEXP_PORT_UNKNOWN_FLAGS;
|
||||
sexp_port_buf(p) = NULL;
|
||||
sexp_port_fd(p) = SEXP_FALSE;
|
||||
sexp_port_openp(p) = 1;
|
||||
sexp_port_bidirp(p) = 0;
|
||||
sexp_port_binaryp(p) = 1;
|
||||
|
|
@ -1723,6 +1778,11 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
|
|||
sexp_write_char(ctx, ')', out);
|
||||
break;
|
||||
#endif
|
||||
case SEXP_FILENO:
|
||||
sexp_write_string(ctx, "#<fileno ", out);
|
||||
sexp_write(ctx, sexp_make_fixnum(sexp_fileno_fd(obj)), out);
|
||||
sexp_write_char(ctx, '>', out);
|
||||
break;
|
||||
default:
|
||||
i = sexp_pointer_tag(obj);
|
||||
if (i < 0 || i >= sexp_context_num_types(ctx)) {
|
||||
|
|
|
|||
|
|
@ -505,6 +505,7 @@
|
|||
((eq? base 'input-port) "sexp_iportp")
|
||||
((eq? base 'output-port) "sexp_oportp")
|
||||
((eq? base 'input-output-port) "sexp_ioportp")
|
||||
((eq? base 'fileno) "sexp_filenop")
|
||||
(else #f))))
|
||||
|
||||
(define (type-name type)
|
||||
|
|
@ -530,6 +531,7 @@
|
|||
((eq? base 'input-port) "SEXP_IPORT")
|
||||
((eq? base 'output-port) "SEXP_OPORT")
|
||||
((eq? base 'input-output-port) "SEXP_IPORT")
|
||||
((eq? base 'fileno) "SEXP_FILENO")
|
||||
((void-pointer-type? type) "SEXP_CPOINTER")
|
||||
((lookup-type base)
|
||||
;; (string-append "sexp_type_tag(" (type-id-name base) ")")
|
||||
|
|
@ -604,6 +606,8 @@
|
|||
(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)"))
|
||||
((eq? 'fileno base)
|
||||
(cat "sexp_make_fileno(ctx, " val ", 0)"))
|
||||
(else
|
||||
(let ((ctype (lookup-type base))
|
||||
(void*? (void-pointer-type? type)))
|
||||
|
|
@ -646,11 +650,13 @@
|
|||
(cat "sexp_concat_env_string(" val ")"))
|
||||
((string-type? base)
|
||||
(cat "sexp_string_data(" val ")"))
|
||||
((eq? base 'port-or-fd)
|
||||
(cat "(sexp_portp(" val ") ? fileno(sexp_port_stream(" val "))"
|
||||
" : sexp_unbox_fixnum(" val "))"))
|
||||
((eq? base 'port-or-fileno)
|
||||
(cat "(sexp_portp(" val ") ? sexp_port_fileno(" val ")"
|
||||
" : sexp_fileno_fd(" val "))"))
|
||||
((port-type? base)
|
||||
(cat "sexp_port_stream(" val ")"))
|
||||
((eq? base 'fileno)
|
||||
(cat "sexp_fileno_fd(" val ")"))
|
||||
(else
|
||||
(let ((ctype (lookup-type base))
|
||||
(void*? (void-pointer-type? type)))
|
||||
|
|
@ -667,6 +673,7 @@
|
|||
(define (base-type-c-name base)
|
||||
(case base
|
||||
((string env-string non-null-string) (if *c++?* "string" "char*"))
|
||||
((fileno) "int")
|
||||
(else (symbol->string base))))
|
||||
|
||||
(define (type-struct-type type)
|
||||
|
|
@ -705,7 +712,7 @@
|
|||
(cat "(sexp_pairp(" arg ") && sexp_stringp(sexp_car(" arg
|
||||
")) && sexp_stringp(sexp_cdr(" arg ")))"))
|
||||
((or (int-type? base) (float-type? base)
|
||||
(string-type? base) (port-type? base))
|
||||
(string-type? base) (port-type? base) (eq? base 'fileno))
|
||||
(cat (type-predicate type) "(" arg ")"))
|
||||
((or (lookup-type base) (void-pointer-type? type))
|
||||
(cat
|
||||
|
|
@ -740,13 +747,14 @@
|
|||
(cat " if (! sexp_nullp(res))\n"
|
||||
" return sexp_xtype_exception(ctx, self, \"not a list of "
|
||||
(type-name type) "s\", " arg ");\n")))
|
||||
((eq? base-type 'port-or-fd)
|
||||
(cat " if (! (sexp_portp(" arg ") || sexp_fixnump(" arg ")))\n"
|
||||
((eq? base-type 'port-or-fileno)
|
||||
(cat " if (! (sexp_portp(" arg ") || sexp_filenop(" arg ")))\n"
|
||||
" return sexp_xtype_exception(ctx, self, \"not a port or file descriptor\"," arg ");\n"))
|
||||
((or (int-type? base-type)
|
||||
(float-type? base-type)
|
||||
(string-type? base-type)
|
||||
(port-type? base-type))
|
||||
(port-type? base-type)
|
||||
(eq? base-type 'fileno))
|
||||
(cat
|
||||
" if (! " (lambda () (check-type arg type)) ")\n"
|
||||
" return sexp_type_exception(ctx, self, "
|
||||
|
|
|
|||
23
vm.c
23
vm.c
|
|
@ -1769,6 +1769,9 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
if (! sexp_oportp(_ARG2))
|
||||
sexp_raise("write-char: not an output-port", sexp_list1(ctx, _ARG2));
|
||||
sexp_context_top(ctx) = top;
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
errno = 0;
|
||||
#endif
|
||||
#if SEXP_USE_UTF8_STRINGS
|
||||
if (sexp_unbox_character(_ARG1) >= 0x80)
|
||||
i = sexp_write_utf8_char(ctx, sexp_unbox_character(_ARG1), _ARG2);
|
||||
|
|
@ -1777,10 +1780,10 @@ 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)) */
|
||||
&& (errno == EAGAIN)
|
||||
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
|
||||
clearerr(sexp_port_stream(_ARG2));
|
||||
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG2));
|
||||
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG2);
|
||||
fuel = 0;
|
||||
ip--; /* try again */
|
||||
|
|
@ -1820,7 +1823,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
#if SEXP_USE_GREEN_THREADS
|
||||
if (i) {
|
||||
i = 0;
|
||||
clearerr(sexp_port_stream(_ARG3));
|
||||
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG3));
|
||||
if (errno == EAGAIN)
|
||||
goto write_string_yield;
|
||||
}
|
||||
|
|
@ -1864,6 +1867,9 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
if (! sexp_iportp(_ARG1))
|
||||
sexp_raise("read-char: not an input-port", sexp_list1(ctx, _ARG1));
|
||||
sexp_context_top(ctx) = top;
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
errno = 0;
|
||||
#endif
|
||||
i = sexp_read_char(ctx, _ARG1);
|
||||
#if SEXP_USE_UTF8_STRINGS
|
||||
if (i >= 0x80)
|
||||
|
|
@ -1872,10 +1878,10 @@ 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)) */
|
||||
&& (errno == EAGAIN)
|
||||
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
|
||||
clearerr(sexp_port_stream(_ARG1));
|
||||
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG1));
|
||||
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG1);
|
||||
fuel = 0;
|
||||
ip--; /* try again */
|
||||
|
|
@ -1891,13 +1897,16 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
if (! sexp_iportp(_ARG1))
|
||||
sexp_raise("peek-char: not an input-port", sexp_list1(ctx, _ARG1));
|
||||
sexp_context_top(ctx) = top;
|
||||
#if SEXP_USE_GREEN_THREADS
|
||||
errno = 0;
|
||||
#endif
|
||||
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)) */
|
||||
&& (errno == EAGAIN)
|
||||
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
|
||||
clearerr(sexp_port_stream(_ARG1));
|
||||
if (sexp_port_stream(_ARG1)) clearerr(sexp_port_stream(_ARG1));
|
||||
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG1);
|
||||
fuel = 0;
|
||||
ip--; /* try again */
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue