Generalized seek/tell on fds and fd-backed ports.

This commit is contained in:
Alex Shinn 2014-05-05 22:22:36 +09:00
parent 27ee1b150e
commit a2cf9db1e5
2 changed files with 24 additions and 3 deletions

View file

@ -11,14 +11,19 @@
(string (value 1 size_t) size_t (default (current-input-port) input-port)))
))
(c-include "port.c")
(define-c-const int (seek/set "SEEK_SET"))
(define-c-const int (seek/cur "SEEK_CUR"))
(define-c-const int (seek/end "SEEK_END"))
(define-c long (file-position "ftell") (port))
(define-c long (set-file-position! "fseek") (port long int))
;; (define-c off_t (file-position "ftell") (port))
;; (define-c off_t (set-file-position! "fseek") (port off_t int))
(c-include "port.c")
(define-c sexp (file-position "sexp_tell")
((value ctx sexp) (value self sexp) sexp))
(define-c sexp (set-file-position! "sexp_seek")
((value ctx sexp) (value self sexp) sexp off_t int))
(define-c boolean (is-a-socket? "sexp_is_a_socket_p") (fileno))

View file

@ -402,6 +402,22 @@ int sexp_is_a_socket_p (int fd) {
#endif
}
sexp sexp_seek (sexp ctx, sexp self, sexp x, off_t offset, int whence) {
if (! (sexp_portp(x) || sexp_filenop(x)))
return sexp_type_exception(ctx, self, SEXP_IPORT, x);
if (sexp_filenop(x))
return sexp_make_integer(ctx, lseek(sexp_fileno_fd(x), offset, whence));
if (sexp_filenop(sexp_port_fd(x)))
return sexp_make_integer(ctx, lseek(sexp_fileno_fd(sexp_port_fd(x)), offset, whence));
if (sexp_stream_portp(x))
return sexp_make_integer(ctx, fseek(sexp_port_stream(x), offset, whence));
return sexp_xtype_exception(ctx, self, "not a seekable port", x);
}
sexp sexp_tell (sexp ctx, sexp self, sexp x) {
return sexp_seek(ctx, self, x, 0, SEEK_CUR);
}
int sexp_send_file (int fd, int s, off_t offset, off_t len, off_t* res) {
#if SEXP_USE_SEND_FILE
*res = len;