Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-08 05:27:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding binary custom ports.

Browse source
This commit is contained in:
Alex Shinn 2014-03-16 20:12:12 +09:00
parent f85c7ffa6f
commit d945e744e1
6 changed files with 106 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lib/chibi/io.sld
View file

@ -5,6 +5,7 @@
port->list port->string-list port->sexp-list port->string
file-position set-file-position! seek/set seek/cur seek/end
make-custom-input-port make-custom-output-port
make-custom-binary-input-port make-custom-binary-output-port
make-null-output-port make-null-input-port
make-broadcast-port make-concatenated-port
make-generated-input-port make-filtered-output-port

50
lib/chibi/io/io.scm
View file

@ -228,19 +228,53 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; custom port utilities
;;> \var{read} is a procedure of three arguments:
;;> \scheme{(lambda (str start end) ...)} which should fill \var{str} from
;;> \var{start} to \var{end} with bytes, returning the actual number
;;> of bytes filled.
(define (make-custom-input-port read . o)
(let ((seek (and (pair? o) (car o)))
(close (and (pair? o) (pair? (cdr o)) (car (cdr o)))))
(%make-custom-input-port read seek close)))
;;> \var{write} is a procedure of three arguments:
;;> \scheme{(lambda (str start end) ...)} which should write the bytes of
;;> \var{str} from \var{start} to \var{end}, returning the actual
;;> number of bytes written.
(define (make-custom-output-port write . o)
(let ((seek (and (pair? o) (car o)))
(close (and (pair? o) (pair? (cdr o)) (car (cdr o)))))
(%make-custom-output-port write seek close)))
;;> Similar to \scheme{make-custom-input-port} but returns a binary
;;> port, and \var{read} receives a bytevector to fill instead of a
;;> string.
(define (make-custom-binary-input-port read . o)
(let ((seek (and (pair? o) (car o)))
(close (and (pair? o) (pair? (cdr o)) (car (cdr o)))))
(%make-custom-binary-input-port read seek close)))
;;> Similar to \scheme{make-custom-output-port} but returns a binary
;;> port, and \var{write} receives data from a bytevector instead of a
;;> string.
(define (make-custom-binary-output-port write . o)
(let ((seek (and (pair? o) (car o)))
(close (and (pair? o) (pair? (cdr o)) (car (cdr o)))))
(%make-custom-binary-output-port write seek close)))
;;> A simple /dev/null port which accepts and does nothing with any
;;> data written to it.
(define (make-null-output-port)
(make-custom-output-port (lambda (str start end) 0)))
;;> A port to broadcast everything written to it to multiple output
;;> ports.
(define (make-broadcast-port . ports)
(make-custom-output-port
(lambda (str start end)
@ -249,6 +283,9 @@
(for-each (lambda (p) (%write-string str n p)) ports)
n))))
;;> An output port which runs all output (in arbitrary string chunks)
;;> through the \var{filter} procedure.
(define (make-filtered-output-port filter out)
(make-custom-output-port
(lambda (str start end)
@ -258,6 +295,9 @@
(if (string? s2)
(%write-string s2 (string-length s2) out))))))
;;> An input port which acts as all of the \var{ports} concatenated
;;> together in order.
(define (make-concatenated-port . ports)
(make-custom-input-port
(lambda (str start end)
@ -281,9 +321,16 @@
(string-copy! str i s 0 len))
(lp (+ i len)))))))))))))
;;> A /dev/null input port which always returns \scheme{eof-object}.
(define (make-null-input-port)
(make-concatenated-port))
;;> A utility to represent a port generated in chunks by the thunk
;;> \var{generator}, which should return a single string representing
;;> the next input to buffer, or \scheme{#f} when there is no more
;;> input.
(define (make-generated-input-port generator)
(let ((buf "")
(len 0)
@ -318,6 +365,9 @@
(string-copy! str i buf offset len)
(lp (+ i (- len offset)))))))))))))))
;;> An input port which runs all input (in arbitrary string chunks)
;;> through the \var{filter} procedure.
(define (make-filtered-input-port filter in)
(make-generated-input-port
(lambda ()

6
lib/chibi/io/io.stub
View file

@ -31,6 +31,12 @@
(define-c sexp (%make-custom-output-port "sexp_make_custom_output_port")
((value ctx sexp) (value self sexp) sexp sexp sexp))
(define-c sexp (%make-custom-binary-input-port "sexp_make_custom_binary_input_port")
((value ctx sexp) (value self sexp) sexp sexp sexp))
(define-c sexp (%make-custom-binary-output-port "sexp_make_custom_binary_output_port")
((value ctx sexp) (value self sexp) sexp sexp sexp))
(define-c sexp (open-input-bytevector "sexp_open_input_bytevector")
((value ctx sexp) (value self sexp) sexp))
(define-c sexp (open-output-bytevector "sexp_open_output_bytevector")

16
lib/chibi/io/port.c
View file

@ -181,6 +181,8 @@ static sexp sexp_make_custom_port (sexp ctx, sexp self, char *mode,
res = sexp_make_input_port(ctx, in, SEXP_FALSE);
sexp_port_cookie(res) = vec; /* for gc preserving */
}
if (mode && mode[0] == 'w')
sexp_pointer_tag(res) = SEXP_OPORT;
sexp_gc_release1(ctx);
return res;
}
@ -234,6 +236,20 @@ sexp sexp_make_custom_output_port (sexp ctx, sexp self,
return res;
}
sexp sexp_make_custom_binary_input_port (sexp ctx, sexp self,
sexp read, sexp seek, sexp close) {
sexp res = sexp_make_custom_input_port(ctx, self, read, seek, close);
sexp_port_binaryp(res) = 1;
return res;
}
sexp sexp_make_custom_binary_output_port (sexp ctx, sexp self,
sexp write, sexp seek, sexp close) {
sexp res = sexp_make_custom_output_port(ctx, self, write, seek, close);
sexp_port_binaryp(res) = 1;
return res;
}
sexp sexp_bytes_to_string (sexp ctx, sexp vec) {
sexp res;
#if SEXP_USE_PACKED_STRINGS

4
sexp.c
View file

@ -1441,7 +1441,7 @@ int sexp_buffered_read_char (sexp ctx, sexp p) {
} else if (sexp_port_customp(p)) {
sexp_gc_preserve1(ctx, tmp);
tmp = sexp_list2(ctx, SEXP_ZERO, sexp_make_fixnum(SEXP_PORT_BUFFER_SIZE));
tmp = sexp_cons(ctx, sexp_port_buffer(p), tmp);
tmp = sexp_cons(ctx, sexp_port_binaryp(p) ? sexp_string_bytes(sexp_port_buffer(p)) : sexp_port_buffer(p), tmp);
tmp = sexp_apply(ctx, sexp_port_reader(p), tmp);
if (sexp_fixnump(tmp) && sexp_unbox_fixnum(tmp) > 0) {
sexp_port_offset(p) = 0;
@ -1518,7 +1518,7 @@ int sexp_buffered_flush (sexp ctx, sexp p, int forcep) {
sexp_gc_preserve1(ctx, tmp);
if (sexp_port_customp(p)) { /* custom port */
tmp = sexp_list2(ctx, SEXP_ZERO, sexp_make_fixnum(sexp_port_offset(p)));
tmp = sexp_cons(ctx, sexp_port_buffer(p), tmp);
tmp = sexp_cons(ctx, sexp_port_binaryp(p) ? sexp_string_bytes(sexp_port_buffer(p)) : sexp_port_buffer(p), tmp);
tmp = sexp_apply(ctx, sexp_port_writer(p), tmp);
res = (sexp_fixnump(tmp) && sexp_unbox_fixnum(tmp) > 0) ? 0 : -1;
} else { /* string port */

32
tests/io-tests.scm
View file

@ -1,6 +1,9 @@
(cond-expand
(modules (import (chibi io) (only (chibi test) test-begin test test-end)))
(modules
(import (chibi io)
(only (scheme base) read-bytevector write-bytevector)
(only (chibi test) test-begin test test-end)))
(else #f))
(test-begin "io")
@ -86,4 +89,31 @@
(display "abc" out)
(close-output-port out)))))
(let ((in (make-custom-binary-input-port
(let ((i 0))
(lambda (bv start end)
(do ((j start (+ j 1)))
((= j end))
(bytevector-u8-set! bv j (modulo (+ j i) 256)))
(if (> end 0)
(set! i (bytevector-u8-ref bv (- end 1))))
(- end start))))))
(test #u8(0 1 2 3) (read-bytevector 4 in))
(test #u8(4 5 6 7) (read-bytevector 4 in))
(test 7 (bytevector-u8-ref (read-bytevector 256 in) 255))
(test 6 (bytevector-u8-ref (read-bytevector 1024 in) 1022)))
(let* ((sum 0)
(out (make-custom-binary-output-port
(lambda (bv start end)
(do ((i start (+ i 1))
(x 0 (+ x (bytevector-u8-ref bv i))))
((= i end) (set! sum x)))))))
(write-bytevector #u8(0 1 2 3) out)
(flush-output out)
(test 6 sum)
(write-bytevector #u8(100) out)
(flush-output out)
(test 106 sum))
(test-end)