diff --git a/CHANGELOG.md b/CHANGELOG.md index 2b47de59..8f9e99be 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## 0.17 - TBD +Bug Fixes + +- Modified `binary-port?` and `textual-port?` to correctly differentiate between binary and textual ports. + ## 0.16 - March 11, 2020 Features diff --git a/include/cyclone/types.h b/include/cyclone/types.h index 5860d234..e6e2bc1b 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -1100,6 +1100,8 @@ typedef struct { size_t str_bv_in_mem_buf_len; } port_type; +#define CYC_BINARY_PORT_FLAG 0x10 + #define CYC_IO_BUF_LEN 1024 /** Create a new port object in the nursery */ diff --git a/runtime.c b/runtime.c index e2457b65..5c4e5ec7 100644 --- a/runtime.c +++ b/runtime.c @@ -4480,12 +4480,16 @@ port_type Cyc_io_open_output_file(void *data, object str) port_type Cyc_io_open_binary_input_file(void *data, object str) { - return _Cyc_io_open_input_file(data, str, "rb"); + port_type p = _Cyc_io_open_input_file(data, str, "rb"); + p.flags |= CYC_BINARY_PORT_FLAG; + return p; } port_type Cyc_io_open_binary_output_file(void *data, object str) { - return _Cyc_io_open_output_file(data, str, "wb"); + port_type p = _Cyc_io_open_output_file(data, str, "wb"); + p.flags |= CYC_BINARY_PORT_FLAG; + return p; } object Cyc_io_close_input_port(void *data, object port) diff --git a/scheme/base.sld b/scheme/base.sld index 6e297ef9..10ec40c9 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -694,12 +694,22 @@ (loop (if chr (cons chr acc) acc) (- i 1) (read-char port)))))))) - ;; TODO: the following procedures should be a bit smarter, but we would - ;; need to track binary/text as part of port_type + (define-c _binary-port? + "(void *data, int argc, closure _, object k, object obj)" + " object rv = boolean_f; + port_type *p = (port_type *)obj; + if (p->flags & CYC_BINARY_PORT_FLAG) { + rv = boolean_t; + } + return_closcall1(data, k, rv); ") + (define (binary-port? obj) - (port? obj)) + (and (port? obj) + (_binary-port? obj)) + ) (define (textual-port? obj) - (port? obj)) + (and (port? obj) + (not (binary-port? obj)))) ;; (define (flush-output-port . port) (if (null? port)