diff --git a/README.md b/README.md index 301423ba..bdd982e9 100644 --- a/README.md +++ b/README.md @@ -155,7 +155,7 @@ At the REPL start-up time, some usuful built-in libraries listed below will be a | 6.11 Exceptions | yes | `raise-continuable` is not supported | | 6.12 Environments and evaluation | N/A | | | 6.13.1 Ports | yes | | -| 6.13.2 Input | incomplete | TODO: binary input | +| 6.13.2 Input | yes | | | 6.13.3 Output | yes | | | 6.14 System interface | yes | | diff --git a/src/port.c b/src/port.c index 84f60297..80fd98db 100644 --- a/src/port.c +++ b/src/port.c @@ -434,6 +434,140 @@ pic_port_char_ready_p(pic_state *pic) return pic_true_value(); /* FIXME: always returns #t */ } +static pic_value +pic_port_read_string(pic_state *pic){ + struct pic_port *port = pic_stdin(pic), *buf; + pic_str *str; + int k, i; + char c; + + pic_get_args(pic, "i|p", &k, &port); + + assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "read-stritg"); + + buf = pic_open_output_string(pic); + for(i = 0; i < k; ++i) { + c = xfgetc(port->file); + if( c == EOF){ + break; + } + xfputc(c, buf->file); + } + + str = pic_get_output_string(pic, buf); + if (pic_strlen(str) == 0 && c == EOF) { + return pic_eof_object(); + } + else { + return pic_obj_value(str); + } + +} + +static pic_value +pic_port_read_byte(pic_state *pic){ + struct pic_port *port = pic_stdin(pic); + + pic_get_args(pic, "|p", &port); + + assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-u8"); + + return pic_int_value((char) xfgetc(port->file)); +} + +static pic_value +pic_port_peek_byte(pic_state *pic) +{ + char c; + struct pic_port *port = pic_stdin(pic); + + pic_get_args(pic, "|p", &port); + + assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "peek-u8"); + + if ((c = xfgetc(port->file)) == EOF) { + return pic_eof_object(); + } + else { + xungetc(c, port->file); + return pic_int_value(c); + } +} + +static pic_value +pic_port_byte_ready_p(pic_state *pic) +{ + struct pic_port *port = pic_stdin(pic); + + assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "char-ready?"); + + pic_get_args(pic, "|p", &port); + + return pic_true_value(); /* FIXME: always returns #t */ +} + + +static pic_value +pic_port_read_blob(pic_state *pic){ + struct pic_port *port = pic_stdin(pic); + int k, i; + char c, *buf; + + pic_get_args(pic, "i|p", &k, &port); + + assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector"); + + buf = pic_calloc(pic, k, sizeof(char)); + for(i = 0; i < k; i++){ + c = xfgetc(port->file); + if( c == EOF ){ + break; + } + buf[i] = c; + } + if ( i == 0 && c == EOF) { + return pic_eof_object(); + } + else { + pic_realloc(pic, buf, i); + return pic_obj_value(pic_blob_new(pic, buf, i)); + } +} + +static pic_value +pic_port_read_blob_ip(pic_state *pic){ + struct pic_port *port; + struct pic_blob *bv; + int i, n, start, end; + char c; + + n = pic_get_args(pic, "b|pii", &bv, &port, &start, &end); + switch (n) { + case 1: + port = pic_stdin(pic); + case 2: + start = 0; + case 3: + end = bv->len; + } + + assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector!"); + + for(i = start; i < end; i++){ + c = xfgetc(port->file); + if( c == EOF ){ + break; + } + bv->data[i] = c; + } + if ( i == start && c == EOF) { + return pic_eof_object(); + } + else { + return pic_int_value(i - start); + } +} + static pic_value pic_port_newline(pic_state *pic) { @@ -571,12 +705,12 @@ pic_init_port(pic_state *pic) pic_defun(pic, "eof-object?", pic_port_eof_object_p); pic_defun(pic, "eof-object", pic_port_eof_object); pic_defun(pic, "char-ready?", pic_port_char_ready_p); - /* pic_defun(pic, "read-string", pic_port_read_string); */ - /* pic_defun(pic, "read-u8", pic_port_read_byte); */ - /* pic_defun(pic, "peek-u8", pic_port_peek_byte); */ + pic_defun(pic, "read-string", pic_port_read_string); + pic_defun(pic, "read-u8", pic_port_read_byte); + pic_defun(pic, "peek-u8", pic_port_peek_byte); /* pic_defun(pic, "u8-ready?", pic_port_byte_ready_p); */ - /* pic_defun(pic, "read-bytevector", pic_port_read_blob); */ - /* pic_defun(pic, "peek-bytevector!", pic_port_read_blob_ip); */ + pic_defun(pic, "read-bytevector", pic_port_read_blob); + pic_defun(pic, "read-bytevector!", pic_port_read_blob_ip); /* output */ pic_defun(pic, "newline", pic_port_newline); diff --git a/t/byteio.scm b/t/byteio.scm new file mode 100644 index 00000000..d47b0ae6 --- /dev/null +++ b/t/byteio.scm @@ -0,0 +1,29 @@ +(import (scheme base) + (scheme write) + (scheme file)) + + +(let ((string-port (open-input-string "hello"))) + (display "read-string: ") + (write (read-string 4 string-port)) + (newline) + (display "read-string more: ") + (write (read-string 4 string-port)) + (newline)) + +(let ((byte-port (open-input-bytevector (bytevector 1 2 3 4 5 6 7 8))) + (buf (make-bytevector 4 98))) + (display "read-u8: ") + (write (read-u8 byte-port)) + (newline) + (display "peek-u8: ") + (write (peek-u8 byte-port)) + (newline) + (display "read-bytevector: ") + (write (read-bytevector 4 byte-port)) + (newline) + (display "read-bytevector!: read size: ") + (write (read-bytevector! buf byte-port 1 3)) + (display " read content: ") + (write buf) + (newline))