diff options
Diffstat (limited to 'stream.c')
| -rw-r--r-- | stream.c | 1988 |
1 files changed, 1353 insertions, 635 deletions
@@ -1,4 +1,4 @@ -/* Copyright 2009-2020 +/* Copyright 2009-2024 * Kaz Kylheku <kaz@kylheku.com> * Vancouver, Canada * All rights reserved. @@ -6,25 +6,27 @@ * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * - * 1. Redistributions of source code must retain the above copyright notice, this - * list of conditions and the following disclaimer. + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. * * 2. Redistributions in binary form must reproduce the above copyright notice, * this list of conditions and the following disclaimer in the documentation * and/or other materials provided with the distribution. * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND - * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE - * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE - * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR - * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, - * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. */ +#define UTF8_DECL_OPENDIR #include <stdio.h> #include <string.h> #include <stddef.h> @@ -53,12 +55,12 @@ #if HAVE_WINDOWS_H #include <windows.h> #endif -#if HAVE_SOCKETS -#include <sys/socket.h> -#endif #if HAVE_WSPAWN || HAVE_SPAWN #include <process.h> #endif +#if HAVE_ZLIB +#include <zlib.h> +#endif #include "alloca.h" #include "lib.h" #include "gc.h" @@ -71,8 +73,13 @@ #include "eval.h" #include "regex.h" #include "txr.h" -#include "arith.h" #include "buf.h" +#if HAVE_ZLIB +#include "gzio.h" +#endif + +#define max(a, b) ((a) > (b) ? (a) : (b)) +#define min(a, b) ((a) < (b) ? (a) : (b)) /* Adhere to ISO C rules about direction switching on update streams. */ #ifndef __gnu_linux__ @@ -88,9 +95,11 @@ val get_error_s, get_error_str_s, clear_error_s, get_fd_s; val print_flo_precision_s, print_flo_digits_s, print_flo_format_s; val pprint_flo_format_s, print_base_s, print_circle_s; +val print_json_format_s; val from_start_k, from_current_k, from_end_k; val real_time_k, name_k, addr_k, fd_k, byte_oriented_k; +val standard_k; val format_s; val stdio_stream_s; @@ -99,13 +108,18 @@ val stdio_stream_s; val socket_error_s; #endif +struct cobj_class *stream_cls, *stdio_stream_cls; + const wchli_t *path_sep_chars = wli("/"); +wchar_t path_var_sep_char = ':'; + +val top_stderr; -val shell, shell_arg; +static val shell, shell_arg; void strm_base_init(struct strm_base *s) { - static struct strm_base init = { indent_off, 60, 10, 0, 0, 0, 0, 0, 0 }; + static struct strm_base init = { indent_off, 60, 10, 0, 0, 0, 0, 0, nil, 0 }; *s = init; } @@ -116,7 +130,8 @@ void strm_base_cleanup(struct strm_base *s) void strm_base_mark(struct strm_base *s) { - (void) s; + if (s->close_result) + gc_mark(s->close_result); } void stream_print_op(val stream, val out, val pretty, struct strm_ctx *ctx) @@ -140,140 +155,165 @@ void stream_mark_op(val stream) strm_base_mark(s); } -static noreturn void unimpl(val stream, val op) +static NORETURN void unimpl(val stream, val op) { uw_throwf(file_error_s, lit("~a: not supported by stream ~s"), op, stream, nao); abort(); } -static noreturn val unimpl_put_string(val stream, val str) +static NORETURN val unimpl_put_string(val stream, val str) { + (void) str; unimpl(stream, lit("put-string")); } -static noreturn val unimpl_put_char(val stream, val ch) +static NORETURN val unimpl_put_char(val stream, val ch) { + (void) ch; unimpl(stream, lit("put-char")); } -static noreturn val unimpl_put_byte(val stream, int byte) +static NORETURN val unimpl_put_byte(val stream, int byte) { + (void) byte; unimpl(stream, lit("put-byte")); } -static noreturn val unimpl_get_line(val stream) +static NORETURN val unimpl_get_line(val stream) { unimpl(stream, lit("get-line")); } -static noreturn val unimpl_get_char(val stream) +static NORETURN val unimpl_get_char(val stream) { unimpl(stream, lit("get-char")); } -static noreturn val unimpl_get_byte(val stream) +static NORETURN val unimpl_get_byte(val stream) { unimpl(stream, lit("get-byte")); } -static noreturn val unimpl_unget_char(val stream, val ch) +static NORETURN val unimpl_unget_char(val stream, val ch) { + (void) ch; unimpl(stream, lit("unget-char")); } -static noreturn val unimpl_unget_byte(val stream, int byte) +static NORETURN val unimpl_unget_byte(val stream, int byte) { + (void) byte; unimpl(stream, lit("unget-byte")); } -static noreturn val unimpl_put_buf(val stream, val buf, cnum pos) +static NORETURN ucnum unimpl_put_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) { + (void) ptr; + (void) len; + (void) pos; unimpl(stream, lit("put-buf")); } -static noreturn val unimpl_fill_buf(val stream, val buf, cnum pos) +static NORETURN ucnum unimpl_fill_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) { + (void) ptr; + (void) len; + (void) pos; unimpl(stream, lit("fill-buf")); } -static noreturn val unimpl_seek(val stream, val off, enum strm_whence whence) +static NORETURN val unimpl_seek(val stream, val off, enum strm_whence whence) { + (void) off; + (void) whence; unimpl(stream, lit("seek-stream")); } -static noreturn val unimpl_truncate(val stream, val len) +static NORETURN val unimpl_truncate(val stream, val len) { + (void) len; unimpl(stream, lit("truncate-stream")); } -static noreturn val unimpl_get_fd(val stream) -{ - unimpl(stream, lit("fileno")); -} - -static noreturn val unimpl_get_sock_family(val stream) +static NORETURN val unimpl_get_sock_family(val stream) { unimpl(stream, lit("sock-family")); } -static noreturn val unimpl_get_sock_type(val stream) +static NORETURN val unimpl_get_sock_type(val stream) { unimpl(stream, lit("sock-type")); } -static noreturn val unimpl_get_sock_peer(val stream) +static NORETURN val unimpl_get_sock_peer(val stream) { unimpl(stream, lit("sock-peer")); } -static noreturn val unimpl_set_sock_peer(val stream, val peer) +static NORETURN val unimpl_set_sock_peer(val stream, val peer) { + (void) peer; unimpl(stream, lit("sock-set-peer")); } static val null_put_string(val stream, val str) { + (void) stream; + (void) str; return nil; } static val null_put_char(val stream, val ch) { + (void) stream; + (void) ch; return nil; } static val null_put_byte(val stream, int byte) { + (void) stream; + (void) byte; return nil; } static val null_get_line(val stream) { + (void) stream; return nil; } static val null_get_char(val stream) { + (void) stream; return nil; } static val null_get_byte(val stream) { + (void) stream; return nil; } static val null_close(val stream, val throw_on_error) { + (void) stream; + (void) throw_on_error; return nil; } static val null_flush(val stream) { + (void) stream; return nil; } static val null_seek(val stream, val off, enum strm_whence whence) { + (void) stream; + (void) off; + (void) whence; return nil; } @@ -289,38 +329,43 @@ static val null_get_prop(val stream, val ind) static val null_set_prop(val stream, val ind, val value) { + (void) stream; + (void) ind; + (void) value; return nil; } static val null_get_error(val stream) { + (void) stream; return nil; } static val null_get_error_str(val stream) { + (void) stream; return nil; } static val null_clear_error(val stream) { + (void) stream; return nil; } static val null_get_fd(val stream) { + (void) stream; return nil; } -static val generic_put_buf(val stream, val buf, cnum pos) +static ucnum generic_put_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) { - val self = lit("put-buf"); struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops); - cnum len = c_num(length_buf(buf)), i; - mem_t *ptr = buf_get(buf, self); + ucnum i; if (pos >= len) - return num(len); + return len; for (i = pos; i < len; i++) ops->put_byte(stream, *ptr++); @@ -328,27 +373,26 @@ static val generic_put_buf(val stream, val buf, cnum pos) if (i > len) i = len; - return num(i); + return i; } -static val generic_fill_buf(val stream, val buf, cnum pos) +static ucnum generic_fill_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) { val self = lit("fill-buf"); struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops); - cnum len = c_num(length_buf(buf)), i; - mem_t *ptr = buf_get(buf, self); + ucnum i; for (i = pos; i < len; i++) { val byte = ops->get_byte(stream); if (!byte) break; - *ptr++ = c_num(byte); + *ptr++ = c_num(byte, self); } if (i > len) i = len; - return num(i); + return i; } void fill_stream_ops(struct strm_ops *ops) @@ -392,7 +436,7 @@ void fill_stream_ops(struct strm_ops *ops) if (!ops->clear_error) ops->clear_error = null_clear_error; if (!ops->get_fd) - ops->get_fd = unimpl_get_fd; + ops->get_fd = null_get_fd; if (!ops->get_sock_family) ops->get_sock_family = unimpl_get_sock_family; if (!ops->get_sock_type) @@ -403,6 +447,45 @@ void fill_stream_ops(struct strm_ops *ops) ops->set_sock_peer = unimpl_set_sock_peer; } +struct dev_null { + struct strm_base a; + int fd; +}; + +static val dev_null_close(val stream, val throw_on_error) +{ + struct dev_null *n = coerce(struct dev_null *, stream->co.handle); + (void) throw_on_error; + if (n->fd != -1) { + close(n->fd); + n->fd = -1; + return t; + } + return nil; +} + +static val dev_null_get_fd(val stream) +{ + struct dev_null *n = coerce(struct dev_null *, stream->co.handle); + if (n->fd == -1 && (n->fd = open("/dev/null", O_RDWR)) == -1) { + int eno = errno; + uw_ethrowf(errno_to_file_error(eno), lit("error opening /dev/null: ~d/~s"), + num(eno), errno_to_str(eno), nao); + } + return num(n->fd); +} + +static val dev_null_get_prop(val stream, val ind) +{ + if (ind == name_k) + return null_get_prop(stream, ind); + + if (ind == fd_k) + return dev_null_get_fd(stream); + + return nil; +} + static struct strm_ops null_ops = strm_ops_init(cobj_ops_init(eq, stream_print_op, @@ -414,16 +497,17 @@ static struct strm_ops null_ops = null_get_char, null_get_byte, unimpl_unget_char, unimpl_unget_byte, unimpl_put_buf, unimpl_fill_buf, - null_close, null_flush, null_seek, unimpl_truncate, - null_get_prop, null_set_prop, + dev_null_close, null_flush, null_seek, unimpl_truncate, + dev_null_get_prop, null_set_prop, null_get_error, null_get_error_str, null_clear_error, - null_get_fd); + dev_null_get_fd); val make_null_stream(void) { - struct strm_base *s = coerce(struct strm_base *, chk_malloc(sizeof *s)); - strm_base_init(s); - return cobj(coerce(mem_t *, s), stream_s, &null_ops.cobj_ops); + struct dev_null *n = coerce(struct dev_null *, chk_malloc(sizeof *n)); + strm_base_init(&n->a); + n->fd = -1; + return cobj(coerce(mem_t *, n), stream_cls, &null_ops.cobj_ops); } #if CONFIG_STDIO_STRICT @@ -440,8 +524,6 @@ struct stdio_handle { char *buf; #if HAVE_FORK_STUFF pid_t pid; -#else - int pid; #endif val mode; /* used by tail */ unsigned is_rotated : 8; /* used by tail */ @@ -501,10 +583,9 @@ static void stdio_stream_mark(val stream) val errno_to_string(val err) { - if (err == zero) - return lit("unspecified error"); - else if (is_num(err)) - return string_utf8(strerror(c_num(err))); + val self = lit("get-error-str"); + if (is_num(err)) + return errno_to_str(c_num(err, self)); else if (!err) return lit("no error"); else if (err == t) @@ -519,14 +600,15 @@ static val stdio_maybe_read_error(val stream) if (h->f == 0) uw_throwf(file_error_s, lit("error reading ~s: file closed"), stream, nao); if (ferror(h->f)) { - val err = num(errno); + int eno = errno; + val err = num(eno); h->err = err; #ifdef EAGAIN - if (errno == EAGAIN) - uw_throwf(timeout_error_s, lit("timed out reading ~s"), stream, nao); + if (eno == EAGAIN) + uw_ethrowf(timeout_error_s, lit("timed out reading ~s"), stream, nao); #endif - uw_throwf(file_error_s, lit("error reading ~s: ~d/~s"), - stream, err, errno_to_string(err), nao); + uw_ethrowf(file_error_s, lit("error reading ~s: ~d/~s"), + stream, err, errno_to_string(err), nao); } if (feof(h->f)) h->err = t; @@ -538,28 +620,21 @@ static val stdio_maybe_error(val stream, val action) struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); val err = num(errno); if (h->f == 0) - uw_throwf(file_error_s, lit("error ~a ~s: file closed"), stream, action, nao); + uw_ethrowf(file_error_s, lit("error ~a ~s: file closed"), action, stream, nao); h->err = err; #ifdef EAGAIN if (errno == EAGAIN) - uw_throwf(timeout_error_s, lit("timed out on ~s"), stream, nao); + uw_ethrowf(timeout_error_s, lit("timed out on ~s"), stream, nao); #endif - uw_throwf(file_error_s, lit("error ~a ~s: ~d/~s"), - stream, action, err, errno_to_string(err), nao); + uw_ethrowf(file_error_s, lit("error ~a ~s: ~d/~s"), + action, stream, err, errno_to_string(err), nao); } static int se_putc(int ch, FILE *f) { int ret; sig_save_enable; -#ifdef __CYGWIN__ - { - char out[2] = { ch, 0 }; - ret = fputs(out, f) == EOF ? EOF : ch; - } -#else ret = putc(ch, f); -#endif sig_restore_enable; return ret; } @@ -619,12 +694,13 @@ static int stdio_get_char_callback(mem_t *f) static val stdio_put_string(val stream, val str) { + val self = lit("put-string"); struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); errno = 0; if (h->f != 0) { - const wchar_t *s = c_str(str); + const wchar_t *s = c_str(str, self); stdio_switch(h, stdio_write); @@ -697,8 +773,6 @@ static val stdio_get_prop(val stream, val ind) return h->is_real_time ? t : nil; } else if (ind == name_k) { return h->descr; - } else if (ind == fd_k) { - return h->f ? num(fileno(h->f)) : nil; } else if (ind == byte_oriented_k) { return h->is_byte_oriented ? t : nil; } @@ -715,6 +789,9 @@ static val stdio_set_prop(val stream, val ind, val prop) } else if (ind == byte_oriented_k) { h->is_byte_oriented = prop ? 1 : 0; return t; + } else if (ind == name_k) { + h->descr = prop; + return t; } return nil; } @@ -751,7 +828,7 @@ static val stdio_get_fd(val stream) { val self = lit("stream-fd"); struct stdio_handle *h = coerce(struct stdio_handle *, - cobj_handle(self, stream, stdio_stream_s)); + cobj_handle(self, stream, stdio_stream_cls)); return h->f ? num(fileno(h->f)) : nil; } @@ -768,7 +845,7 @@ val generic_get_line(val stream) for (;;) { val chr = ops->get_char(stream); - wint_t ch = chr ? c_chr(chr) : WEOF; + wint_t ch = chr ? convert(wint_t, c_chr(chr)) : WEOF; if (ch == WEOF && buf == 0) break; @@ -863,57 +940,53 @@ static val stdio_unget_byte(val stream, int byte) : stdio_maybe_error(stream, lit("writing")); } -static val stdio_put_buf(val stream, val buf, cnum pos) +static ucnum stdio_put_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) { val self = lit("put-buf"); - ucnum len = c_unum(length_buf(buf)); - mem_t *ptr = buf_get(buf, self); struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); if (convert(size_t, len) != len || len > INT_PTR_MAX) uw_throwf(error_s, lit("~a: buffer too large"), self, nao); - if (convert(ucnum, pos) >= len) - return num(len); + if (pos >= len) + return len; errno = 0; if (h->f != 0) { cnum nwrit = fwrite(ptr + pos, 1, len - pos, h->f); if (nwrit > 0) - return num(pos + nwrit); + return pos + nwrit; } stdio_maybe_error(stream, lit("writing")); - return zero; + return 0; } -static val stdio_fill_buf(val stream, val buf, cnum pos) +static ucnum stdio_fill_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) { val self = lit("fill-buf"); - ucnum len = c_unum(length_buf(buf)); - mem_t *ptr = buf_get(buf, self); struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); if (convert(size_t, len) != len || len > INT_PTR_MAX) uw_throwf(error_s, lit("~a: buffer too large"), self, nao); - if (convert(ucnum, pos) >= len) - return num(len); + if (pos >= len) + return len; errno = 0; if (h->f != 0) { cnum nread = fread(ptr + pos, 1, len - pos, h->f); if (nread > 0) - return num(pos + nread); + return pos + nread; } stdio_maybe_read_error(stream); - return num(pos); + return pos; } static val stdio_close(val stream, val throw_on_error) { struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); - if (h->f != 0 && h->f != stdin && h->f != stdout) { + if (h->f != 0 && h->f != stdin && h->f != stdout && h->f != stderr) { int result = fclose(h->f); h->f = 0; - if (result == EOF && throw_on_error) { + if (result == EOF && default_null_arg(throw_on_error)) { h->err = num(errno); - uw_throwf(file_error_s, lit("error closing ~s: ~d/~s"), - stream, num(errno), string_utf8(strerror(errno)), nao); + uw_ethrowf(file_error_s, lit("error closing ~s: ~d/~s"), + stream, num(errno), errno_to_str(errno), nao); } return result != EOF ? t : nil; } @@ -923,8 +996,9 @@ static val stdio_close(val stream, val throw_on_error) #if HAVE_FTRUNCATE || HAVE_CHSIZE static val stdio_truncate(val stream, val len) { + val self = lit("truncate-stream"); struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); - cnum l = c_num(len); + cnum l = c_num(len, self); #if HAVE_FTRUNCATE typedef off_t trunc_off_t; int (*truncfun)(int, off_t) = ftruncate; @@ -1047,25 +1121,49 @@ static struct strm_ops stdio_ops = static struct strm_ops stdio_sock_ops; #endif +#if HAVE_FCNTL +int w_open_mode(const wchar_t *wname, const struct stdio_mode m) +{ + char *name = utf8_dup_to(wname); + size_t nsiz = strlen(name) + 1; + int flags = (if3(m.read && m.write, O_RDWR, 0) | + if3(m.read && !m.write, O_RDONLY, 0) | + if3(!m.read && m.write, O_WRONLY, 0) | + if3(m.create, if3(!m.notrunc, O_TRUNC, 0) | O_CREAT, 0) | + if3(m.append, O_APPEND, 0) | + if3(m.excl, O_EXCL, 0) | +#if O_TMPFILE + if3(m.tmpfile, O_TMPFILE, 0) | +#endif + if3(m.nonblock, O_NONBLOCK, 0)); + char *stkname = coerce(char *, alloca(nsiz)); + int fd; + + memcpy(stkname, name, nsiz); + free(name); + + sig_save_enable; + fd = open(stkname, flags, 0666); + sig_restore_enable; + + return fd; +} +#endif + static FILE *w_fopen_mode(const wchar_t *wname, const wchar_t *mode, const struct stdio_mode m) { #if HAVE_FCNTL - if (m.notrunc) { - char *name = utf8_dup_to(wname); - int flags = (m.read ? O_RDWR : O_WRONLY) | O_CREAT; - int fd = open(name, flags, 0777); - free(name); - if (fd < 0) - return NULL; - return (fd < 0) ? NULL : w_fdopen(fd, mode); - } + int fd = w_open_mode(wname, m); + return (fd < 0) ? NULL : w_fdopen(fd, mode); #else - if (m.notrunc) + /* TODO: detect if fopen supports "x" in mode */ + if (m.notrunc || m.excl || m.nonblock) uw_throwf(file_error_s, - lit("open-file: \"m\" mode not supported on this system"), nao); -#endif + lit("open-file: specified mode not supported on this system"), + nao); return w_fopen(wname, mode); +#endif } @@ -1082,6 +1180,7 @@ static void tail_calc(unsigned long *state, int *usec, int *mod) static void tail_strategy(val stream, unsigned long *state) { + val self = lit("open-tail"); struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); int usec = 0, mod = 0; val mode = nil; @@ -1117,11 +1216,11 @@ static void tail_strategy(val stream, unsigned long *state) FILE *newf; if (!mode) - mode = normalize_mode(&m, h->mode, m_r); + mode = normalize_mode(&m, h->mode, m_r, self); /* Try to open the file. */ - if (!(newf = w_fopen_mode(c_str(h->descr), c_str(mode), m))) { + if (!(newf = w_fopen_mode(c_str(h->descr, self), c_str(mode, self), m))) { /* If already have the file open previously, and the name * does not open any more, then the file has rotated. * Have the caller try to read the last bit of data @@ -1267,61 +1366,45 @@ static int pipevp_close(FILE *f, pid_t pid) sig_restore_enable; return status; } -#endif -static int se_pclose(FILE *f) +val pipe_close_status_helper(val stream, val throw_on_error, + int status, val self) { - int ret; - sig_save_enable; - ret = pclose(f); - sig_restore_enable; - return ret; + if (status < 0) { + if (throw_on_error) + uw_ethrowf(process_error_s, + lit("~a: stream ~s: unable to obtain status of process: ~d/~s"), + self, stream, num(errno), errno_to_str(errno), nao); + return nil; + } else { +#if HAVE_SYS_WAIT + if (WIFEXITED(status)) { + int exitstatus = WEXITSTATUS(status); + return num(exitstatus); + } else if (default_null_arg(throw_on_error)) { + if (WIFSIGNALED(status)) { + int termsig = WTERMSIG(status); + uw_throwf(process_error_s, lit("~a: stream ~s: process terminated by signal ~a"), + self, stream, num(termsig), nao); + } + } +#endif + return status == 0 ? zero : nil; + } } static val pipe_close(val stream, val throw_on_error) { + val self = lit("close-stream"); struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); if (h->f != 0) { -#if HAVE_FORK_STUFF - int status = h->pid != 0 ? pipevp_close(h->f, h->pid) : se_pclose(h->f); -#else - int status = se_pclose(h->f); -#endif + int status = pipevp_close(h->f, h->pid); h->f = 0; - if (status < 0) { - if (throw_on_error) - uw_throwf(process_error_s, - lit("unable to obtain status of command ~s: ~d/~s"), - stream, num(errno), string_utf8(strerror(errno)), nao); - } else { -#if HAVE_SYS_WAIT - if (throw_on_error) { - if (WIFSIGNALED(status)) { - int termsig = WTERMSIG(status); - uw_throwf(process_error_s, lit("pipe ~s terminated by signal ~a"), - stream, num(termsig), nao); -#ifndef WIFCONTINUED -#define WIFCONTINUED(X) 0 -#endif - } else if (WIFSTOPPED(status) || WIFCONTINUED(status)) { - uw_throwf(process_error_s, - lit("processes of closed pipe ~s still running"), - stream, nao); - } - } - if (WIFEXITED(status)) { - int exitstatus = WEXITSTATUS(status); - return num(exitstatus); - } -#else - if (status != 0 && throw_on_error) - uw_throwf(process_error_s, lit("closing pipe ~s failed"), stream, nao); -#endif - return status == 0 ? zero : nil; - } + return pipe_close_status_helper(stream, throw_on_error, status, self); } + return nil; } @@ -1352,11 +1435,13 @@ static struct strm_ops pipe_ops = stdio_get_error_str, stdio_clear_error, stdio_get_fd); +#endif -static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl) +static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl, + val self) { struct stdio_mode m = stdio_mode_init_blank; - const wchar_t *ms = c_str(default_arg(mode_str, lit(""))); + const wchar_t *ms = c_str(default_arg_strict(mode_str, null_string), self); int nredir = 0; switch (*ms) { @@ -1372,7 +1457,9 @@ static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl) case 'a': ms++; m.write = 1; + m.create = 1; m.append = 1; + m.notrunc = 1; break; case 'm': ms++; @@ -1380,15 +1467,24 @@ static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl) m.create = 1; m.notrunc = 1; break; + case 'T': + ms++; +#if O_TMPFILE + m.read = 1; + m.write = 1; + m.tmpfile = 1; +#else + m.malformed = 1; +#endif + break; default: break; } if (*ms == '+') { ms++; - if (m.read) - m.write = 1; m.read = 1; + m.write = 1; } if (!m.read && !m.write) @@ -1399,6 +1495,14 @@ static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl) case 'b': m.binary = 1; break; + case 'x': + /* Ensure only "w" and "w+" can have the "x" option. */ + if (!m.write || !m.create || m.notrunc) { + m.malformed = 1; + return m; + } + m.excl = 1; + break; case 'i': m.interactive = 1; break; @@ -1416,6 +1520,9 @@ static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl) } m.unbuf = 1; break; + case 'n': + m.nonblock = 1; + break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': if (m.unbuf) { @@ -1431,13 +1538,13 @@ static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl) } if (ms[1] != '(') { - if (!isdigit((unsigned char) ms[1]) || !ms[2]) { + if (!isdigit(convert(unsigned char, ms[1])) || !ms[2]) { m.malformed = 1; return m; } m.redir[nredir][0] = ms[1] - '0'; - if (isdigit((unsigned char) ms[2])) { + if (isdigit(convert(unsigned char, ms[2]))) { m.redir[nredir][1] = ms[2] - '0'; } else switch (ms[2]) { case 'n': case 'x': @@ -1473,6 +1580,13 @@ static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl) nredir++; break; } + case 'z': + m.gzip = 1; + if (isdigit(convert(unsigned char, ms[1]))) { + m.gzlevel = *++ms - '0'; + break; + } + break; default: m.malformed = 1; return m; @@ -1485,11 +1599,12 @@ static struct stdio_mode do_parse_mode(val mode_str, struct stdio_mode m_dfl) return m; } -struct stdio_mode parse_mode(val mode_str, struct stdio_mode m_dfl) +struct stdio_mode parse_mode(val mode_str, struct stdio_mode m_dfl, val self) { - struct stdio_mode m = do_parse_mode(mode_str, m_dfl); + struct stdio_mode m = do_parse_mode(mode_str, m_dfl, self); if (m.malformed) - uw_throwf(file_error_s, lit("invalid mode string ~s"), mode_str, nao); + uw_throwf(file_error_s, lit("~a: invalid mode string ~s"), self, + mode_str, nao); return m; } @@ -1514,11 +1629,14 @@ static val format_mode(const struct stdio_mode m) *ptr++ = '+'; } - if (m.binary) + if (m.binary && !m.gzip) *ptr++ = 'b'; + if (m.gzip && m.gzlevel) + *ptr++ = '0' + m.gzlevel; + #ifdef __CYGWIN__ - if (!m.binary && (opt_compat == 144 || opt_compat == 145)) + if (!m.gzip && !m.binary && (opt_compat == 144 || opt_compat == 145)) *ptr++ = 't'; #endif @@ -1526,25 +1644,29 @@ static val format_mode(const struct stdio_mode m) return string(buf); } -val normalize_mode(struct stdio_mode *m, val mode_str, struct stdio_mode m_dfl) +val normalize_mode(struct stdio_mode *m, val mode_str, struct stdio_mode m_dfl, + val self) { - *m = do_parse_mode(mode_str, m_dfl); + *m = do_parse_mode(mode_str, m_dfl, self); if (m->malformed) - uw_throwf(file_error_s, lit("invalid file open mode ~s"), mode_str, nao); + uw_throwf(file_error_s, lit("~a: invalid file open mode ~s"), + self, mode_str, nao); return format_mode(*m); } -val normalize_mode_no_bin(struct stdio_mode *m, val mode_str, struct stdio_mode m_dfl) +val normalize_mode_no_bin(struct stdio_mode *m, val mode_str, + struct stdio_mode m_dfl, val self) { #ifdef __CYGWIN__ - return normalize_mode(m, mode_str, m_dfl); + return normalize_mode(m, mode_str, m_dfl, self); #else - *m = do_parse_mode(mode_str, m_dfl); + *m = do_parse_mode(mode_str, m_dfl, self); if (m->malformed) - uw_throwf(file_error_s, lit("invalid file open mode ~s"), mode_str, nao); + uw_throwf(file_error_s, lit("~a: invalid file open mode ~s"), + self, mode_str, nao); m->binary = 0; @@ -1585,7 +1707,7 @@ val set_mode_props(const struct stdio_mode m, val stream) static val make_stdio_stream_common(FILE *f, val descr, struct cobj_ops *ops) { struct stdio_handle *h = coerce(struct stdio_handle *, chk_malloc(sizeof *h)); - val stream = cobj(coerce(mem_t *, h), stdio_stream_s, ops); + val stream = cobj(coerce(mem_t *, h), stdio_stream_cls, ops); strm_base_init(&h->a); h->f = f; h->descr = descr; @@ -1627,11 +1749,6 @@ val make_tail_stream(FILE *f, val descr) return stream; } -val make_pipe_stream(FILE *f, val descr) -{ - return make_stdio_stream_common(f, descr, &pipe_ops.cobj_ops); -} - #if HAVE_SOCKETS val make_sock_stream(FILE *f, val family, val type) { @@ -1647,7 +1764,7 @@ val stream_fd(val stream) { val self = lit("fileno"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_fd(stream); } @@ -1656,7 +1773,7 @@ val sock_family(val stream) { val self = lit("sock-family"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_sock_family(stream); } @@ -1664,7 +1781,7 @@ val sock_type(val stream) { val self = lit("sock-type"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_sock_type(stream); } @@ -1672,7 +1789,7 @@ val sock_peer(val stream) { val self = lit("sock-peer"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_sock_peer(stream); } @@ -1680,7 +1797,7 @@ val sock_set_peer(val stream, val peer) { val self = lit("sock-set-peer"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->set_sock_peer(stream, peer); } #endif @@ -1739,10 +1856,12 @@ static val dir_get_line(val stream) static val dir_close(val stream, val throw_on_error) { struct dir_handle *h = coerce(struct dir_handle *, stream->co.handle); + (void) throw_on_error; if (h->d != 0) { closedir(coerce(DIR *, h->d)); h->d = 0; + return t; } return nil; @@ -1791,7 +1910,7 @@ static val make_dir_stream(DIR *dir) strm_base_init(&h->a); h->d = dir; h->err = nil; - return cobj(coerce(mem_t *, h), stream_s, &dir_ops.cobj_ops); + return cobj(coerce(mem_t *, h), stream_cls, &dir_ops.cobj_ops); } struct string_in { @@ -1914,7 +2033,7 @@ val make_string_input_stream(val string) strm_base_init(&s->a); s->string = string; s->pos = zero; - return cobj(coerce(mem_t *, s), stream_s, &string_in_ops.cobj_ops); + return cobj(coerce(mem_t *, s), stream_cls, &string_in_ops.cobj_ops); } struct byte_input { @@ -1984,15 +2103,16 @@ static struct strm_ops byte_in_ops = val make_string_byte_input_stream(val string) { - type_assert (stringp(string), (lit("~a is not a string"), string, nao)); + val self = lit("make-string-byte-input-stream"); + type_assert (stringp(string), (lit("~a: ~s is not a string"), self, string, nao)); { - const wchar_t *wstring = c_str(string); + const wchar_t *wstring = c_str(string, self); struct byte_input *bi = coerce(struct byte_input *, chk_malloc(sizeof *bi)); strm_base_init(&bi->a); bi->buf = utf8_dup_to_buf(wstring, &bi->size, 0); bi->index = 0; - return cobj(coerce(mem_t *, bi), stream_s, &byte_in_ops.cobj_ops); + return cobj(coerce(mem_t *, bi), stream_cls, &byte_in_ops.cobj_ops); } } @@ -2123,12 +2243,13 @@ static struct strm_ops strlist_in_ops = val make_strlist_input_stream(val list) { - struct strlist_in *s = coerce(struct strlist_in *, chk_malloc(sizeof *s)); + struct strlist_in *s = coerce(struct strlist_in *, chk_calloc(sizeof *s, 1)); + val stream = cobj(coerce(mem_t *, s), stream_cls, &strlist_in_ops.cobj_ops); strm_base_init(&s->a); s->string = car(list); s->pos = zero; s->list = cdr(list); - return cobj(coerce(mem_t *, s), stream_s, &strlist_in_ops.cobj_ops); + return stream; } struct string_out { @@ -2189,6 +2310,7 @@ static val string_out_byte_flush(struct string_out *so, val stream) static val string_out_put_string(val stream, val str) { + val self = lit("put-string"); struct string_out *so = coerce(struct string_out *, stream->co.handle); if (so->buf == 0) @@ -2198,8 +2320,8 @@ static val string_out_put_string(val stream, val str) string_out_byte_flush(so, stream); { - const wchar_t *s = c_str(str); - size_t len = c_num(length_str(str)); + const wchar_t *s = c_str(str, self); + size_t len = c_num(length_str(str), self); size_t old_size = so->size; size_t required_size = len + so->fill + 1; @@ -2220,7 +2342,7 @@ static val string_out_put_string(val stream, val str) so->fill += len; return t; oflow: - uw_throw(error_s, lit("string output stream overflow")); + uw_throwf(error_s, lit("~a: string output stream overflow"), self, nao); } } @@ -2272,17 +2394,18 @@ val make_string_output_stream(void) so->buf[0] = 0; utf8_decoder_init(&so->ud); so->head = so->tail = 0; - return cobj(coerce(mem_t *, so), stream_s, &string_out_ops.cobj_ops); + return cobj(coerce(mem_t *, so), stream_cls, &string_out_ops.cobj_ops); } val get_string_from_stream(val stream) { val self = lit("get-string-from-stream"); struct string_out *so = coerce(struct string_out *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); if (stream->co.ops == &string_out_ops.cobj_ops) { val out = nil; + wchar_t *buf; if (!so->buf) return out; @@ -2291,14 +2414,14 @@ val get_string_from_stream(val stream) out = string_out_byte_flush(so, stream); /* Trim to actual size */ - so->buf = coerce(wchar_t *, chk_realloc(coerce(mem_t *, so->buf), - (so->fill + 1) * sizeof *so->buf)); - out = string_own(so->buf); + buf = coerce(wchar_t *, chk_realloc(coerce(mem_t *, so->buf), + (so->fill + 1) * sizeof *so->buf)); so->buf = 0; + out = string_own(buf); return out; } else { type_assert (stream->co.ops == &string_in_ops.cobj_ops, - (lit("~a is not a string stream"), stream, nao)); + (lit("~a: ~s is not a string stream"), self, stream, nao)); { struct string_in *si = coerce(struct string_in *, stream->co.handle); return si->string; @@ -2388,7 +2511,7 @@ val make_strlist_output_stream(void) strm_base_init(&s->a); s->lines = nil; s->strstream = nil; - stream = cobj(coerce(mem_t *, s), stream_s, &strlist_out_ops.cobj_ops); + stream = cobj(coerce(mem_t *, s), stream_cls, &strlist_out_ops.cobj_ops); s->strstream = strstream; return stream; } @@ -2397,7 +2520,7 @@ val get_list_from_stream(val stream) { val self = lit("get-list-from-stream"); struct strlist_out *s = coerce(struct strlist_out *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); if (stream->co.ops == &strlist_out_ops.cobj_ops) { val stray = get_string_from_stream(s->strstream); @@ -2407,7 +2530,7 @@ val get_list_from_stream(val stream) return nreverse(lines); } - type_mismatch(lit("~s is not a string list stream"), stream); + type_mismatch(lit("~a: ~s is not a string list stream"), self, stream, nao); } struct cat_strm { @@ -2578,12 +2701,12 @@ val make_catenated_stream(val stream_list) val catstrm = nil; strm_base_init(&s->a); s->streams = nil; - catstrm = cobj(coerce(mem_t *, s), stream_s, &cat_stream_ops.cobj_ops); + catstrm = cobj(coerce(mem_t *, s), stream_cls, &cat_stream_ops.cobj_ops); s->streams = stream_list; return catstrm; } -val make_catenated_stream_v(struct args *streams) +val make_catenated_stream_v(varg streams) { return make_catenated_stream(args_get_list(streams)); } @@ -2595,10 +2718,12 @@ val catenated_stream_p(val obj) val catenated_stream_push(val new_stream, val cat_stream) { + val self = lit("catenated-stream-push"); + type_assert (streamp(new_stream), - (lit("~a is not a stream"), new_stream, nao)); + (lit("~a: ~s is not a stream"), self, new_stream, nao)); type_assert (catenated_stream_p(cat_stream), - (lit("~a is not a stream"), cat_stream, nao)); + (lit("~a: ~s is not a stream"), self, cat_stream, nao)); { struct cat_strm *s = coerce(struct cat_strm *, cat_stream->co.handle); @@ -2661,16 +2786,16 @@ static val delegate_unget_byte(val stream, int byte) return s->target_ops->unget_byte(s->target_stream, byte); } -static val delegate_put_buf(val stream, val buf, cnum pos) +static ucnum delegate_put_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) { struct delegate_base *s = coerce(struct delegate_base *, stream->co.handle); - return s->target_ops->put_buf(s->target_stream, buf, pos); + return s->target_ops->put_buf(s->target_stream, ptr, len, pos); } -static val delegate_fill_buf(val stream, val buf, cnum pos) +static ucnum delegate_fill_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) { struct delegate_base *s = coerce(struct delegate_base *, stream->co.handle); - return s->target_ops->fill_buf(s->target_stream, buf, pos); + return s->target_ops->fill_buf(s->target_stream, ptr, len, pos); } static val delegate_close(val stream, val throw_on_error) @@ -2765,7 +2890,7 @@ static val make_delegate_stream(val self, val orig_stream, size_t handle_size, struct cobj_ops *ops) { struct strm_ops *orig_ops = coerce(struct strm_ops *, - cobj_ops(self, orig_stream, stream_s)); + cobj_ops(self, orig_stream, stream_cls)); struct delegate_base *db = coerce(struct delegate_base *, chk_calloc(1, handle_size)); val delegate_stream; @@ -2774,7 +2899,7 @@ static val make_delegate_stream(val self, val orig_stream, size_t handle_size, db->target_stream = nil; db->target_ops = orig_ops; - delegate_stream = cobj(coerce(mem_t *, db), stream_s, ops); + delegate_stream = cobj(coerce(mem_t *, db), stream_cls, ops); db->target_stream = orig_stream; @@ -2826,7 +2951,8 @@ static struct strm_ops record_adapter_ops = val record_adapter(val regex, val stream, val include_match) { val self = lit("record-adapter"); - val rec_adapter = make_delegate_stream(self, default_arg(stream, std_input), + val rec_adapter = make_delegate_stream(self, + default_arg_strict(stream, std_input), sizeof (struct record_adapter_base), &record_adapter_ops.cobj_ops); struct record_adapter_base *rb = coerce(struct record_adapter_base *, @@ -2846,7 +2972,7 @@ val stream_set_prop(val stream, val ind, val prop) { val self = lit("stream-set-prop"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->set_prop(stream, ind, prop); } @@ -2854,7 +2980,11 @@ val stream_get_prop(val stream, val ind) { val self = lit("stream-get-prop"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); + + if (ind == fd_k && ops->get_fd != null_get_fd) + return ops->get_fd(stream); + return ops->get_prop(stream, ind); } @@ -2871,16 +3001,28 @@ val real_time_stream_p(val obj) val close_stream(val stream, val throw_on_error) { val self = lit("close-stream"); - struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); - return ops->close(stream, throw_on_error); + struct strm_base *s = coerce(struct strm_base *, + cobj_handle(self, stream, stream_cls)); + struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops); + val res = s->close_result; + + if (!res) { + res = ops->close(stream, throw_on_error); + + if (res == colon_k) + res = t; + else if (res) + s->close_result = res; + } + + return res; } val get_error(val stream) { val self = lit("get-error"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_error(stream); } @@ -2888,7 +3030,7 @@ val get_error_str(val stream) { val self = lit("get-error-str"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_error_str(stream); } @@ -2896,43 +3038,51 @@ val clear_error(val stream) { val self = lit("clear-error"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->clear_error(stream); } val get_line(val stream_in) { val self = lit("get-line"); - val stream = default_arg(stream_in, std_input); + val stream = default_arg_strict(stream_in, std_input); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_line(stream); } val get_char(val stream_in) { val self = lit("get-char"); - val stream = default_arg(stream_in, std_input); + val stream = default_arg_strict(stream_in, std_input); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_char(stream); } val get_byte(val stream_in) { val self = lit("get-byte"); - val stream = default_arg(stream_in, std_input); + val stream = default_arg_strict(stream_in, std_input); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->get_byte(stream); } +val get_bytes(val self, val stream_in, mem_t *ptr, ucnum len) +{ + val stream = default_arg_strict(stream_in, std_input); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_cls)); + return unum(ops->fill_buf(stream, ptr, len, 0)); +} + val unget_char(val ch, val stream_in) { val self = lit("unget-char"); - val stream = default_arg(stream_in, std_input); + val stream = default_arg_strict(stream_in, std_input); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); if (!is_chr(ch)) type_mismatch(lit("~a: ~s is not a character"), self, ch, nao); return ops->unget_char(stream, ch); @@ -2941,10 +3091,10 @@ val unget_char(val ch, val stream_in) val unget_byte(val byte, val stream_in) { val self = lit("unget-byte"); - cnum b = c_num(byte); - val stream = default_arg(stream_in, std_input); + cnum b = c_num(byte, self); + val stream = default_arg_strict(stream_in, std_input); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); if (b < 0 || b > 255) uw_throwf(file_error_s, lit("~a: stream ~s: byte value ~a out of range"), @@ -2956,39 +3106,76 @@ val unget_byte(val byte, val stream_in) val put_buf(val buf, val pos_in, val stream_in) { val self = lit("put-buf"); - val stream = default_arg(stream_in, std_output); - cnum pos = c_num(default_arg(pos_in, zero)); + val stream = default_arg_strict(stream_in, std_output); + ucnum pos = c_unum(default_arg_strict(pos_in, zero), self); + ucnum len = c_unum(length_buf(buf), self); + mem_t *ptr = buf_get(buf, self); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); - return ops->put_buf(stream, buf, pos); + cobj_ops(self, stream, stream_cls)); + + return unum(ops->put_buf(stream, ptr, len, pos)); } val fill_buf(val buf, val pos_in, val stream_in) { val self = lit("fill-buf"); - val stream = default_arg(stream_in, std_input); - cnum pos = c_num(default_arg(pos_in, zero)); + val stream = default_arg_strict(stream_in, std_input); + ucnum pos = c_unum(default_arg_strict(pos_in, zero), self); + ucnum len = c_unum(length_buf(buf), self); + mem_t *ptr = buf_get(buf, self); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); - return ops->fill_buf(stream, buf, pos); + cobj_ops(self, stream, stream_cls)); + return unum(ops->fill_buf(stream, ptr, len, pos)); } val fill_buf_adjust(val buf, val pos_in, val stream_in) { val self = lit("fill-buf-adjust"); - val stream = default_arg(stream_in, std_input); - cnum pos = c_num(default_arg(pos_in, zero)); + val stream = default_arg_strict(stream_in, std_input); + ucnum pos = c_unum(default_arg_strict(pos_in, zero), self); + val alloc_size = buf_alloc_size(buf); + ucnum len = c_unum(alloc_size, self); + mem_t *ptr = buf_get(buf, self); val readpos; struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); - buf_set_length(buf, buf_alloc_size(buf), zero); - readpos = ops->fill_buf(stream, buf, pos); + cobj_ops(self, stream, stream_cls)); + buf_set_length(buf, alloc_size, zero); + readpos = unum(ops->fill_buf(stream, ptr, len, pos)); buf_set_length(buf, readpos, zero); return readpos; } +val get_line_as_buf(val stream_in) +{ + val self = lit("get-line-as-buf"); + val stream = default_arg_strict(stream_in, std_input); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_cls)); + val buf = make_buf(zero, nil, num_fast(128)); + unsigned char bytes[128]; + size_t count = 0; + + for (;;) { + val b = ops->get_byte(stream); + if (b == nil || b == num('\n')) + break; + bytes[count++] = c_num(b, self); + + if (count == sizeof bytes) { + buf_put_bytes(buf, length_buf(buf), bytes, count, self); + count = 0; + } + } + + if (count > 0) + buf_put_bytes(buf, length_buf(buf), bytes, count, self); + + buf_trim(buf); + return buf; +} + struct fmt { - size_t minsize; + const char *type; const char *dec; const char *oct; const char *hex; @@ -2996,13 +3183,14 @@ struct fmt { }; static struct fmt fmt_tab[] = { - { sizeof(short),"%hd", "%ho", "%hx", "%hX" }, - { sizeof(int), "%d", "%o", "%x", "%X" }, - { sizeof(long), "%ld", "%lo", "%lx", "%llX" }, - { sizeof(cnum), "%lld", "%llo", "%llx", "%llX" }, - { sizeof(cnum), "%Ld", "%Lo", "%Lx", "%llX" }, - { sizeof(cnum), "%qd", "%qo", "%qx", "%qX", }, - { sizeof(cnum), "%I64d", "%I64o", "%I64x", "%I64X" }, + { "short", "%hd", "%ho", "%hx", "%hX" }, + { "int", "%d", "%o", "%x", "%X" }, + { "long", "%ld", "%lo", "%lx", "%lX" }, + { "long long", "%lld", "%llo", "%llx", "%llX" }, + { "long long", "%Ld", "%Lo", "%Lx", "%LX" }, + { "long long", "%qd", "%qo", "%qx", "%qX", }, + { "int64", "%I64d", "%I64o", "%I64x", "%I64X" }, + { "__int64", "%I64d", "%I64o", "%I64x", "%I64X" }, { 0, 0, 0, 0, 0 } }; @@ -3013,16 +3201,29 @@ static void detect_format_string(void) struct fmt *f; char buf[64]; cnum num = 1234; + const char *cnum_type = if3(strcmp(INTPTR_TYPE, "longlong_t") == 0, + LONGLONG_TYPE, INTPTR_TYPE); - for (f = fmt_tab; f->minsize != 0; f++) { + for (f = fmt_tab; f->type != 0; f++) { + if (strcmp(cnum_type, f->type) != 0) + continue; memset(buf, 0, sizeof buf); - if (f->minsize != sizeof num) + if (sprintf(buf, f->dec, num) != 4 || strcmp(buf, "1234") != 0) continue; - if (sprintf(buf, f->dec, num) == 4 && strcmp(buf, "1234") == 0) { - num_fmt = f; - break; - } + memset(buf, 0, sizeof buf); + if (sprintf(buf, f->oct, num) != 4 || strcmp(buf, "2322") != 0) + continue; + memset(buf, 0, sizeof buf); + if (sprintf(buf, f->hex, num) != 3 || strcmp(buf, "4d2") != 0) + continue; + memset(buf, 0, sizeof buf); + if (sprintf(buf, f->HEX, num) != 3 || strcmp(buf, "4D2") != 0) + continue; + num_fmt = f; + break; } + + bug_unless (num_fmt != 0); } enum align { al_left, al_center, al_right }; @@ -3065,12 +3266,18 @@ static void vformat_align_post(val stream, enum align align, int slack) static void vformat_num(val stream, const char *str, int width, enum align align, int zeropad, - int precision, int sign) + int precision, int add_sign) { int sign_char = (str[0] == '-' || str[0] == '+') ? str[0] : 0; + int have_sign = sign_char == '-'; + int mandatory_sign = have_sign || add_sign == '+'; int digit_len = strlen(str) - (sign_char != 0); - int padlen = precision > digit_len ? precision - digit_len : 0; - int total_len = digit_len + padlen + (sign_char || sign); + int overflow = digit_len > precision; + int padlen = overflow ? 0 : precision - digit_len; + int tentative_len = digit_len + padlen + (have_sign || add_sign); + int total_len = (tentative_len > width && + (have_sign || add_sign) + && !mandatory_sign) ? tentative_len - 1 : tentative_len; int slack = (total_len < width) ? width - total_len : 0; int i; @@ -3080,11 +3287,13 @@ static void vformat_num(val stream, const char *str, for (i = 0; i < padlen; i++) put_char(chr(' '), stream); - if (sign_char) { - put_char(chr(sign_char), stream); + if (sign_char) str++; - } else if (sign) { - put_char(chr(sign), stream); + + if (mandatory_sign) { + put_char(chr(have_sign ? sign_char : add_sign), stream); + } else if (add_sign && tentative_len <= width) { + put_char(chr(add_sign), stream); } if (zeropad) @@ -3123,7 +3332,8 @@ static cnum calc_fitlen(const wchar_t *cstr, int precision, int width) static void vformat_str(val stream, val str, int width, enum align align, int precision) { - const wchar_t *cstr = c_str(str); + val self = lit("format"); + const wchar_t *cstr = c_str(str, self); cnum fitlen = calc_fitlen(cstr, precision, width); cnum slack = (fitlen < width) ? width - fitlen : 0; cnum i, w; @@ -3146,7 +3356,7 @@ static void vformat_str(val stream, val str, int width, enum align align, gc_hint(str); } -val formatv(val stream_in, val fmtstr, struct args *al) +val formatv(val stream_in, val fmtstr, varg al) { uses_or2; val stream = if3(stream_in == t, @@ -3154,21 +3364,23 @@ val formatv(val stream_in, val fmtstr, struct args *al) or2(stream_in, make_string_output_stream())); val save_indent = get_indent(stream); val save_mode = nil; - val name = lit("format"); + val self = lit("format"); uw_simple_catch_begin; { - const wchar_t *fmt = c_str(fmtstr); + const wchar_t *fmt = c_str(fmtstr, self); enum { vf_init, vf_width, vf_digits, vf_star, vf_precision, vf_spec } state = vf_init, saved_state = vf_init; - int width = 0, precision = 0, precision_p = 0, digits = 0, lt = 0, neg = 0; - enum align align = al_right; - int sign = 0, zeropad = 0, dfl_precision = 0; - int dfl_digits = 0, print_base = 0; cnum value; cnum arg_ix = 0; + /* conversion variables that are reset before for each conversion */ + int width = 0, precision = 0, precision_p = 0, digits = 0, lt = 0, neg = 0; + int sign = 0, zeropad = 0; + enum align align = al_right; + /* conversion variables that persist across conversions */ + int dfl_precision = 0, dfl_digits = 0, print_base = 0; for (;;) { val obj; @@ -3183,14 +3395,9 @@ val formatv(val stream_in, val fmtstr, struct args *al) break; case '~': state = vf_width; - width = 0; + width = precision = precision_p = 0; + digits = lt = neg = sign = zeropad = 0; align = al_right; - zeropad = 0; - precision = 0; - precision_p = 0; - digits = 0; - lt = 0; - neg = 0; continue; default: put_char(chr(ch), stream); @@ -3235,8 +3442,11 @@ val formatv(val stream_in, val fmtstr, struct args *al) case vf_precision: switch (ch) { case '0': - zeropad = 1; - continue; + if (!zeropad) { + zeropad = 1; + continue; + } + /* fallthrough */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': saved_state = state; @@ -3246,6 +3456,9 @@ val formatv(val stream_in, val fmtstr, struct args *al) case '+': case ' ': sign = ch; continue; + case '-': + sign = '0'; + continue; case '*': saved_state = state; state = vf_star; @@ -3263,7 +3476,7 @@ val formatv(val stream_in, val fmtstr, struct args *al) digits = (digits * 10) + (ch - '0'); if (digits > 999999) uw_throwf(assert_s, lit("~a: ridiculous precision or field"), - name, nao); + self, nao); continue; default: do_digits: @@ -3296,35 +3509,61 @@ val formatv(val stream_in, val fmtstr, struct args *al) } break; case vf_star: - obj = args_get_checked(name, al, &arg_ix); - digits = c_num(obj); + obj = args_get_checked(self, al, &arg_ix); + digits = c_num(obj, self); goto do_digits; break; case vf_spec: state = vf_init; + if (zeropad && !precision_p) { + zeropad = precision = 0; + precision_p = 1; + } switch (ch) { case 'x': case 'X': - obj = args_get_checked(name, al, &arg_ix); + obj = args_get_checked(self, al, &arg_ix); typ = type(obj); hex: - if (typ == BGNUM) { - int nchars = mp_radix_size(mp(obj), 16); - if (nchars >= convert(int, sizeof (num_buf))) - pnum = coerce(char *, chk_malloc(nchars + 1)); - mp_toradix_case(mp(obj), coerce(unsigned char *, pnum), 16, ch == 'x'); - } else { - const char *fmt = ch == 'x' ? num_fmt->hex : num_fmt->HEX; - value = c_num(obj); - if (value < 0) { - num_buf[0] = '-'; - sprintf(num_buf + 1, fmt, -value); - } else { - sprintf(num_buf, fmt, value); + switch (typ) { + case BGNUM: + { + int nchars = mp_radix_size(mp(obj), 16); + if (nchars >= convert(int, sizeof (num_buf))) + pnum = coerce(char *, chk_malloc(nchars + 1)); + mp_toradix_case(mp(obj), coerce(unsigned char *, pnum), 16, ch == 'x'); + } + break; + case BUF: + { + ucnum len = c_unum(length_buf(obj), self); + ucnum nchars = 2 * len + 1; + + if (len >= INT_PTR_MAX) + uw_throwf(error_s, lit("~a: ~~~a conversion given " + "too large a buf argument"), + self, chr(ch), nao); + + pnum = coerce(char *, chk_malloc(nchars)); + buf_hex(obj, pnum, nchars, ch == 'X'); + } + break; + case NUM: + case CHR: + default: + { + const char *fmt = ch == 'x' ? num_fmt->hex : num_fmt->HEX; + value = c_num(obj, self); + if (value < 0) { + num_buf[0] = '-'; + sprintf(num_buf + 1, fmt, -value); + } else { + sprintf(num_buf, fmt, value); + } } } goto output_num; case 'o': case 'b': - obj = args_get_checked(name, al, &arg_ix); + obj = args_get_checked(self, al, &arg_ix); typ = type(obj); oct: if (typ == BGNUM) { @@ -3334,10 +3573,10 @@ val formatv(val stream_in, val fmtstr, struct args *al) pnum = coerce(char *, chk_malloc(nchars + 1)); mp_toradix(mp(obj), coerce(unsigned char *, pnum), rad); } else if (ch == 'o') { - cnum value = c_num(obj); + cnum value = c_num(obj, self); sprintf(num_buf, num_fmt->oct, value); } else { - cnum val = c_num(obj); + cnum val = c_num(obj, self); int s = (val < 0); int i = sizeof num_buf; @@ -3359,7 +3598,7 @@ val formatv(val stream_in, val fmtstr, struct args *al) } goto output_num; case 'f': case 'e': - obj = args_get_checked(name, al, &arg_ix); + obj = args_get_checked(self, al, &arg_ix); { double n; @@ -3372,29 +3611,33 @@ val formatv(val stream_in, val fmtstr, struct args *al) n = c_flo(obj, lit("format")); break; case NUM: - n = convert(double, c_num(obj)); + n = convert(double, c_num(obj, self)); break; default: - uw_throwf(error_s, lit("format: ~~~a conversion requires " + uw_throwf(error_s, lit("~a: ~~~a conversion requires " "numeric arg: ~s given"), - chr(ch), obj, nao); + self, chr(ch), obj, nao); } if (!precision_p) { if (!dfl_digits) - dfl_digits = c_num(cdr(lookup_var(nil, print_flo_digits_s))); + dfl_digits = c_num(cdr(lookup_var(nil, print_flo_digits_s)), self); precision = dfl_digits; } /* guard against num_buf overflow */ if (precision > 128) - uw_throwf(error_s, lit("excessive precision in format: ~s"), - num(precision), nao); + uw_throwf(error_s, lit("~a: excessive precision: ~s"), + self, num(precision), nao); if (ch == 'e') { sprintf(num_buf, "%.*e", precision, n); { +#if CONFIG_LOCALE_TOLERANCE + char *dec = strchr(num_buf, dec_point); +#else char *dec = strchr(num_buf, '.'); +#endif char *exp = strchr(dec ? dec : num_buf, 'e'); if (exp) { @@ -3425,19 +3668,26 @@ val formatv(val stream_in, val fmtstr, struct args *al) continue; } precision = (width ? width - 1 : 0); +#if CONFIG_LOCALE_TOLERANCE + if (dec_point != '.') { + char *dot = num_buf; + while ((dot = strchr(dot, dec_point)) != 0) + *dot++ = '.'; + } +#endif goto output_num; } case 'd': - obj = args_get_checked(name, al, &arg_ix); + obj = args_get_checked(self, al, &arg_ix); typ = type(obj); goto dec; case 'a': case 's': - obj = args_get_checked(name, al, &arg_ix); + obj = args_get_checked(self, al, &arg_ix); typ = type(obj); if (typ == NUM || typ == BGNUM) { if (!print_base) - print_base = c_num(cdr(lookup_var(nil, print_base_s))); + print_base = c_num(cdr(lookup_var(nil, print_base_s)), self); switch (print_base) { case 0: case 2: @@ -3458,8 +3708,10 @@ val formatv(val stream_in, val fmtstr, struct args *al) dec: switch (typ) { case NUM: - value = c_num(obj); + value = c_num(obj, self); sprintf(num_buf, num_fmt->dec, value); + if (width) + precision = min(precision, width - 1); goto output_num; case BGNUM: { @@ -3468,20 +3720,31 @@ val formatv(val stream_in, val fmtstr, struct args *al) pnum = coerce(char *, chk_malloc(nchars + 1)); mp_toradix(mp(obj), coerce(unsigned char *, pnum), 10); } + if (width) + precision = min(precision, width - 1); goto output_num; case FLNUM: if (!precision_p) { if (!dfl_precision) dfl_precision = c_num(cdr(lookup_var(nil, - print_flo_precision_s))); + print_flo_precision_s)), + self); precision = dfl_precision; } if (precision > 500) - uw_throwf(error_s, lit("excessive precision in format: ~s"), - num(precision), nao); + uw_throwf(error_s, lit("~a: excessive precision: ~s"), + self, num(precision), nao); - sprintf(num_buf, "%.*g", precision, obj->fl.n); + sprintf(num_buf, "%.*g", precision, c_f(obj)); + +#if CONFIG_LOCALE_TOLERANCE + if (dec_point != '.') { + char *dot = num_buf; + while ((dot = strchr(dot, dec_point)) != 0) + *dot++ = '.'; + } +#endif { char *dec = strchr(num_buf, '.'); @@ -3505,7 +3768,7 @@ val formatv(val stream_in, val fmtstr, struct args *al) } if (ch == 's' && (!precision_p || precision > 0) && !dec && !exp) - strcat(num_buf, ".0"); + strcat(num_buf, ".0"); } if (!isdigit(num_buf[0]) && !isdigit(num_buf[1])) { @@ -3513,7 +3776,8 @@ val formatv(val stream_in, val fmtstr, struct args *al) continue; } - precision = (width ? width - 1 : 0); + precision = max(0, min(precision, width - 1)); + goto output_num; default: if (width != 0 || precision_p) { @@ -3527,7 +3791,7 @@ val formatv(val stream_in, val fmtstr, struct args *al) continue; case 'p': { - val ptr = args_get_checked(name, al, &arg_ix); + val ptr = args_get_checked(self, al, &arg_ix); value = coerce(cnum, ptr); sprintf(num_buf, num_fmt->hex, value); } @@ -3561,7 +3825,7 @@ val formatv(val stream_in, val fmtstr, struct args *al) } if (args_more(al, arg_ix)) - uw_throwf(assert_s, lit("~a: excess arguments"), name, nao); + uw_throwf(assert_s, lit("~a: excess arguments"), self, nao); } @@ -3581,7 +3845,7 @@ val formatv(val stream_in, val fmtstr, struct args *al) val vformat(val stream, val fmtstr, va_list vl) { val arg; - args_decl(args, ARGS_MAX); + args_decl_constsize(args, ARGS_MAX); while ((arg = va_arg(vl, val)) != nao) args_add_checked(lit("format"), args, arg); @@ -3603,7 +3867,7 @@ val format(val stream, val str, ...) val st = if3(stream == t, std_output, or2(stream, make_string_output_stream())); - class_check(self, st, stream_s); + class_check(self, st, stream_cls); { va_list vl; @@ -3615,7 +3879,7 @@ val format(val stream, val str, ...) } } -val fmt(val string, struct args *args) +val fmt(val string, varg args) { return formatv(nil, string, args); } @@ -3631,17 +3895,18 @@ static val put_indent(val stream, struct strm_ops *ops, cnum chars) val put_string(val string, val stream_in) { val self = lit("put-string"); - val stream = default_arg(stream_in, std_output); - struct strm_base *s = coerce(struct strm_base *, stream->co.handle); + val stream = default_arg_strict(stream_in, std_output); + struct strm_base *s = coerce(struct strm_base *, + cobj_handle(self, stream, stream_cls)); if (lazy_stringp(string)) { return lazy_str_put(string, stream_in, s); } else { struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); cnum col = s->column; - const wchar_t *str = c_str(string), *p = str; + const wchar_t *str = c_str(string, self), *p = str; if (s->indent_mode != indent_off && s->indent_mode != indent_foff) { while (*str) @@ -3674,10 +3939,11 @@ val put_string(val string, val stream_in) val put_char(val ch, val stream_in) { val self = lit("put-char"); - val stream = default_arg(stream_in, std_output); + val stream = default_arg_strict(stream_in, std_output); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); - struct strm_base *s = coerce(struct strm_base *, stream->co.handle); + cobj_ops(self, stream, stream_cls)); + struct strm_base *s = coerce(struct strm_base *, + cobj_handle(self, stream, stream_cls)); wint_t cch = c_chr(ch); switch (cch) { @@ -3716,10 +3982,10 @@ val put_char(val ch, val stream_in) val put_byte(val byte, val stream_in) { val self = lit("put-byte"); - val stream = default_arg(stream_in, std_output); + val stream = default_arg_strict(stream_in, std_output); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); - cnum b = c_num(byte); + cobj_ops(self, stream, stream_cls)); + cnum b = c_num(byte, self); if (b < 0 || b > 255) uw_throwf(file_error_s, lit("~a: stream ~s: byte value ~a out of range"), @@ -3728,9 +3994,11 @@ val put_byte(val byte, val stream_in) return ops->put_byte(stream, b); } -val put_line(val string, val stream) +val put_line(val string, val stream_in) { - return (put_string(default_arg(string, null_string), stream), put_char(chr('\n'), stream)); + val stream = default_arg_strict(stream_in, std_output); + return (put_string(default_arg_strict(string, null_string), stream), + put_char(chr('\n'), stream)); } val put_strings(val strings, val stream) @@ -3754,9 +4022,9 @@ val put_lines(val lines, val stream) val flush_stream(val stream_in) { val self = lit("flush-stream"); - val stream = default_arg(stream_in, std_output); + val stream = default_arg_strict(stream_in, std_output); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); return ops->flush(stream); } @@ -3764,7 +4032,7 @@ val seek_stream(val stream, val offset, val whence) { val self = lit("seek-stream"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); enum strm_whence w; if (whence == from_start_k) @@ -3784,7 +4052,7 @@ val truncate_stream(val stream, val len) { val self = lit("truncate-stream"); struct strm_ops *ops = coerce(struct strm_ops *, - cobj_ops(self, stream, stream_s)); + cobj_ops(self, stream, stream_cls)); if (missingp(len)) len = ops->seek(stream, zero, strm_cur); return ops->truncate(stream, len); @@ -3794,7 +4062,7 @@ val get_indent_mode(val stream) { val self = lit("get-indent-mode"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); return num_fast(s->indent_mode); } @@ -3802,10 +4070,10 @@ val test_set_indent_mode(val stream, val compare, val mode) { val self = lit("test-set-indent-mode"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); val oldval = num_fast(s->indent_mode); if (oldval == compare) - s->indent_mode = convert(enum indent_mode, c_num(mode)); + s->indent_mode = convert(enum indent_mode, c_num(mode, self)); return oldval; } @@ -3813,10 +4081,10 @@ val test_neq_set_indent_mode(val stream, val compare, val mode) { val self = lit("test-neq-set-indent-mode"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); val oldval = num_fast(s->indent_mode); if (oldval != compare) - s->indent_mode = convert(enum indent_mode, c_num(mode)); + s->indent_mode = convert(enum indent_mode, c_num(mode, self)); return oldval; } @@ -3824,9 +4092,9 @@ val set_indent_mode(val stream, val mode) { val self = lit("set-indent-mode"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); val oldval = num_fast(s->indent_mode); - s->indent_mode = convert(enum indent_mode, c_num(mode)); + s->indent_mode = convert(enum indent_mode, c_num(mode, self)); return oldval; } @@ -3834,7 +4102,7 @@ val get_indent(val stream) { val self = lit("get-indent"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); return num(s->indent_chars); } @@ -3842,9 +4110,9 @@ val set_indent(val stream, val indent) { val self = lit("set-indent"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); val oldval = num(s->indent_chars); - s->indent_chars = c_num(indent); + s->indent_chars = c_num(indent, self); if (s->indent_chars < 0) s->indent_chars = 0; return oldval; @@ -3854,10 +4122,22 @@ val inc_indent(val stream, val delta) { val self = lit("inc-indent"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); val oldval = num(s->indent_chars); val col = num(s->column); - s->indent_chars = c_num(plus(delta, col)); + s->indent_chars = c_num(plus(delta, col), self); + if (s->indent_chars < 0) + s->indent_chars = 0; + return oldval; +} + +val inc_indent_abs(val stream, val delta) +{ + val self = lit("inc-indent-abs"); + struct strm_base *s = coerce(struct strm_base *, + cobj_handle(self, stream, stream_cls)); + val oldval = num(s->indent_chars); + s->indent_chars = c_num(plus(delta, oldval), self); if (s->indent_chars < 0) s->indent_chars = 0; return oldval; @@ -3867,7 +4147,7 @@ val width_check(val stream, val alt) { val self = lit("width-check"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); if ((s->indent_mode == indent_code && s->column >= s->indent_chars + s->code_width) || @@ -3890,7 +4170,7 @@ val force_break(val stream) { val self = lit("force-break"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); s->force_break = 1; return stream; } @@ -3899,9 +4179,9 @@ val set_max_length(val stream, val length) { val self = lit("set-max-length"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); cnum old_max = s->max_length; - s->max_length = c_num(length); + s->max_length = c_num(length, self); return num(old_max); } @@ -3909,9 +4189,9 @@ val set_max_depth(val stream, val depth) { val self = lit("set-max-depth"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(self, stream, stream_s)); + cobj_handle(self, stream, stream_cls)); cnum old_max = s->max_depth; - s->max_depth = c_num(depth); + s->max_depth = c_num(depth, self); return num(old_max); } @@ -3929,11 +4209,11 @@ struct strm_ctx *get_ctx(val stream) return s->ctx; } -val get_string(val stream_in, val nchars, val close_after_p) +val get_string(val stream_in, val nchars_in, val close_after_p) { - val stream = default_arg(stream_in, std_input); + val stream = default_arg_strict(stream_in, std_input); val strstream = make_string_output_stream(); - nchars = default_null_arg(nchars); + val nchars = default_null_arg(nchars_in); val ch; if (nchars) { @@ -3952,24 +4232,16 @@ val get_string(val stream_in, val nchars, val close_after_p) return get_string_from_stream(strstream); } -static DIR *w_opendir(const wchar_t *wname) -{ - char *name = utf8_dup_to(wname); - DIR *d = opendir(name); - free(name); - return d; -} - - val open_directory(val path) { - DIR *d = w_opendir(c_str(path)); + val self = lit("open-directory"); + DIR *d = w_opendir(c_str(path, self)); if (!d) { int eno = errno; - uw_throwf(errno_to_file_error(eno), - lit("error opening directory ~s: ~d/~s"), - path, num(eno), string_utf8(strerror(eno)), nao); + uw_ethrowf(errno_to_file_error(eno), + lit("error opening directory ~s: ~d/~s"), + path, num(eno), errno_to_str(eno), nao); } return make_dir_stream(d); @@ -3977,49 +4249,109 @@ val open_directory(val path) val open_file(val path, val mode_str) { + val self = lit("open-file"); struct stdio_mode m, m_r = stdio_mode_init_r; - val norm_mode = normalize_mode(&m, mode_str, m_r); - FILE *f = w_fopen_mode(c_str(path), c_str(norm_mode), m); + val norm_mode = normalize_mode(&m, mode_str, m_r, self); - if (!f) { - int eno = errno; - uw_throwf(errno_to_file_error(eno), lit("error opening ~s: ~d/~s"), - path, num(eno), string_utf8(strerror(eno)), nao); +#if HAVE_ZLIB +again: +#endif + if (!m.gzip) { + FILE *f = w_fopen_mode(c_str(path, self), c_str(norm_mode, self), m); + + if (!f) + goto error; + + return set_mode_props(m, make_stdio_stream(f, path)); + } else { +#if HAVE_ZLIB + gzFile f = w_gzopen_mode(c_str(path, self), c_str(norm_mode, self), + m, self); + + if (!f) + goto error; + + if (m.read && gzdirect(f)) { + gzclose(f); + m.gzip = 0; + goto again; + } + + return make_gzio_stream(f, -1, path, m.write); +#else + uw_ethrowf(file_error_s, lit("~a: not built with zlib support"), + self, nao); +#endif } - return set_mode_props(m, make_stdio_stream(f, path)); +error: + { + int eno = errno; + uw_ethrowf(errno_to_file_error(eno), lit("error opening ~s: ~d/~s"), + path, num(eno), errno_to_str(eno), nao); + } } -val open_fileno(val fd, val mode_str) +val open_fileno(val fd, val mode_str, val pid_opt) { + val self = lit("open-fileno"); struct stdio_mode m, m_r = stdio_mode_init_r; - FILE *f = (errno = 0, w_fdopen(c_num(fd), c_str(normalize_mode(&m, mode_str, m_r)))); + val norm_mode = normalize_mode(&m, mode_str, m_r, self); + val pid = default_arg(pid_opt, nil); - if (!f) { - int eno = errno; - close(c_num(fd)); - uw_throwf(errno_to_file_error(eno), lit("error opening descriptor ~a: ~d/~s"), - fd, num(eno), string_utf8(strerror(eno)), nao); - } + if (!m.gzip) { + FILE *f = (errno = 0, w_fdopen(c_num(fd, self), + c_str(norm_mode, self))); + + if (!f) + { + int eno = errno; + close(c_num(fd, self)); + uw_ethrowf(errno_to_file_error(eno), + lit("error opening descriptor ~a: ~d/~s"), + fd, num(eno), errno_to_str(eno), nao); + } - return set_mode_props(m, make_stdio_stream(f, format(nil, - lit("fd ~d"), - fd, nao))); + { + val descr = format(nil, lit("fd ~d"), fd, nao); + +#if HAVE_FORK_STUFF + return set_mode_props(m, if3(pid, + make_pipevp_stream(f, descr, + c_num(pid, self)), + make_stdio_stream(f, descr))); +#else + return set_mode_props(m, make_stdio_stream(f, descr)); +#endif + } + + } else { +#if HAVE_ZLIB + cnum fdn = c_num(fd, self); + gzFile f = w_gzdopen_mode(fdn, c_str(norm_mode, self), m, self); + return make_gzio_stream(f, fdn, format(nil, lit("fd ~d"), fd, nao), + m.write); +#else + uw_ethrowf(file_error_s, lit("~a: not built with zlib support"), + self, nao); +#endif + } } val open_tail(val path, val mode_str, val seek_end_p) { + val self = lit("open-tail"); struct stdio_mode m, m_r = stdio_mode_init_r; - val mode = normalize_mode(&m, mode_str, m_r); - FILE *f = w_fopen_mode(c_str(path), c_str(mode), m); + val mode = normalize_mode(&m, mode_str, m_r, self); + FILE *f = w_fopen_mode(c_str(path, self), c_str(mode, self), m); struct stdio_handle *h; val stream; unsigned long state = 0; if (f && default_null_arg(seek_end_p)) if (fseek(f, 0, SEEK_END) < 0) - uw_throwf(file_error_s, lit("error seeking to end of ~s: ~d/~s"), - path, num(errno), string_utf8(strerror(errno)), nao); + uw_ethrowf(file_error_s, lit("error seeking to end of ~s: ~d/~s"), + path, num(errno), errno_to_str(errno), nao); stream = make_tail_stream(f, path); h = coerce(struct stdio_handle *, stream->co.handle); @@ -4033,6 +4365,9 @@ struct save_fds { volatile int in; volatile int out; volatile int err; + volatile int subin; + volatile int subout; + volatile int suberr; }; #define FDS_IN 1 @@ -4041,39 +4376,72 @@ struct save_fds { static void fds_init(struct save_fds *fds) { - fds->in = fds->out = fds->err = -1; + fds->in = fds->out = fds->err = fds->subin = fds->subin = fds->subin = -1; } -static int fds_subst(val stream, int fd_std) +static int fds_getfd(val stream, val self) { - int fd_orig = c_num(stream_fd(stream)); + val sfd = stream_fd(stream); + int fd_sub = if3(integerp(sfd), c_num(sfd, self), INT_MIN); + - if (fd_orig == fd_std) + if (fd_sub == INT_MIN) + uw_throwf(file_error_s, lit("~a: (fileno ~s) is ~s, which is unusable"), + self, stream, sfd, nao); + + return fd_sub; +} + +#if HAVE_WSPAWN || HAVE_SPAWN +static int fds_subst(int fd_sub, int fd_std, val self) +{ + if (fd_sub == fd_std) return -1; { int fd_dup = dup(fd_std); if (fd_dup != -1) { - dup2(fd_orig, fd_std); + dup2(fd_sub, fd_std); return fd_dup; } - uw_throwf(file_error_s, lit("failed to duplicate file descriptor: ~d/~s"), - num(errno), string_utf8(strerror(errno)), nao); + uw_ethrowf(file_error_s, lit("~a: failed to duplicate file descriptor: ~d/~s"), + self, num(errno), errno_to_str(errno), nao); } } +#endif + +static void fds_subst_nosave(int fd_sub, int fd_std) +{ + if (fd_sub == fd_std) + return; + dup2(fd_sub, fd_std); +} -static void fds_swizzle(struct save_fds *fds, int flags) +static void fds_prepare(struct save_fds *fds, int flags, val self) { if ((flags & FDS_IN) != 0) - fds->in = fds_subst(std_input, STDIN_FILENO); + fds->subin = fds_getfd(std_input, self); if ((flags & FDS_OUT) != 0) - fds->out = fds_subst(std_output, STDOUT_FILENO); + fds->subout = fds_getfd(std_output, self); if ((flags & FDS_ERR) != 0) - fds->err = fds_subst(std_error, STDERR_FILENO); + fds->suberr = fds_getfd(std_error, self); +} + +#if HAVE_WSPAWN || HAVE_SPAWN +static void fds_swizzle(struct save_fds *fds, int flags, val self) +{ + if ((flags & FDS_IN) != 0) + fds->in = fds_subst(fds->subin, STDIN_FILENO, self); + + if ((flags & FDS_OUT) != 0) + fds->out = fds_subst(fds->subout, STDOUT_FILENO, self); + + if ((flags & FDS_ERR) != 0) + fds->err = fds_subst(fds->suberr, STDERR_FILENO, self); } static void fds_restore(struct save_fds *fds) @@ -4093,37 +4461,43 @@ static void fds_restore(struct save_fds *fds) close(fds->err); } } +#endif - -val open_command(val path, val mode_str) +static void fds_clobber(struct save_fds *fds, int flags) { - struct stdio_mode m, m_r = stdio_mode_init_r; - val mode = normalize_mode_no_bin(&m, mode_str, m_r); - int input = m.read != 0; - struct save_fds sfds; - FILE *f = 0; - - fds_init(&sfds); - - uw_simple_catch_begin; + if ((flags & FDS_IN) != 0) + fds_subst_nosave(fds->subin, STDIN_FILENO); - fds_swizzle(&sfds, (input ? FDS_IN : FDS_OUT) | FDS_ERR); + if ((flags & FDS_OUT) != 0) + fds_subst_nosave(fds->subout, STDOUT_FILENO); - f = w_popen(c_str(path), c_str(mode)); + if ((flags & FDS_ERR) != 0) + fds_subst_nosave(fds->suberr, STDERR_FILENO); +} - if (!f) { - int eno = errno; - uw_throwf(errno_to_file_error(eno), lit("error opening pipe ~s: ~d/~s"), - path, num(eno), string_utf8(strerror(eno)), nao); - } +val path_search(val name, val path_in) +{ + val self = lit("path-search"); + val ps = static_str(path_sep_chars); - uw_unwind { - fds_restore(&sfds); + if (empty(name) || equal(name, lit(".")) || equal(name, lit(".."))) { + return nil; + } else if (break_str(name, ps)) { + return name; + } else { + val path = default_arg_strict(path_in, getenv_wrap(lit("PATH"))); + val spath = if3(listp(path), path, split_str(path, chr(path_var_sep_char))); + for (; spath; spath = cdr(spath)) { + val dir = car(spath); + val full = path_cat(dir, name); + char *full8 = utf8_dup_to(c_str(full, self)); + int res = access(full8, F_OK); + free(full8); + if (res == 0) + return full; + } + return nil; } - - uw_catch_end; - - return set_mode_props(m, make_pipe_stream(f, path)); } #if HAVE_FORK_STUFF @@ -4131,8 +4505,7 @@ static val open_subprocess(val name, val mode_str, val args, val fun) { val self = lit("open-subprocess"); struct stdio_mode m, m_r = stdio_mode_init_r; - val mode = normalize_mode(&m, mode_str, m_r); - int input = m.read != 0; + int input = (normalize_mode(&m, mode_str, m_r, self), m.read != 0); int fd[2]; pid_t pid; char **argv = 0; @@ -4140,19 +4513,21 @@ static val open_subprocess(val name, val mode_str, val args, val fun) int i, nargs; struct save_fds sfds; val ret = nil; + int fds_flags = (input ? FDS_IN : FDS_OUT) | FDS_ERR; args = default_null_arg(args); fun = default_null_arg(fun); - nargs = c_num(length(args)) + 1; + nargs = c_num(length(args), self) + 1; if (!name && !fun) uw_throwf(error_s, lit("~a: program name and/or function required"), self, nao); - fds_init(&sfds); + if (!input) + flush_stream(std_output); - uw_simple_catch_begin; + fds_init(&sfds); - fds_swizzle(&sfds, (input ? FDS_IN : FDS_OUT) | FDS_ERR); + fds_prepare(&sfds, fds_flags, self); if (nargs < 0 || nargs == INT_MAX) uw_throwf(error_s, lit("~a: argument list overflow"), self, nao); @@ -4163,15 +4538,15 @@ static val open_subprocess(val name, val mode_str, val args, val fun) if (pipe(fd) == -1) { int eno = errno; free(argv); - uw_throwf(errno_to_file_error(eno), - lit("opening pipe ~s, pipe syscall failed: ~d/~s"), - name, num(eno), string_utf8(strerror(eno)), nao); + uw_ethrowf(errno_to_file_error(eno), + lit("opening pipe ~s, pipe syscall failed: ~d/~s"), + name, num(eno), errno_to_str(eno), nao); } if (argv) { for (i = 0, iter = cons(name, args); iter; i++, iter = cdr(iter)) { val arg = car(iter); - argv[i] = utf8_dup_to(c_str(arg)); + argv[i] = utf8_dup_to(c_str(arg, self)); } argv[i] = 0; } @@ -4184,11 +4559,13 @@ static val open_subprocess(val name, val mode_str, val args, val fun) free(argv[i]); free(argv); } - uw_throwf(process_error_s, lit("opening pipe ~s, fork syscall failed: ~d/~s"), - name, num(errno), string_utf8(strerror(errno)), nao); + uw_ethrowf(process_error_s, lit("opening pipe ~s, fork syscall failed: ~d/~s"), + name, num(errno), errno_to_str(errno), nao); } if (pid == 0) { + fds_clobber(&sfds, fds_flags); + if (input) { dup2(fd[1], STDOUT_FILENO); if (fd[1] != STDOUT_FILENO) /* You never know */ @@ -4232,13 +4609,15 @@ static val open_subprocess(val name, val mode_str, val args, val fun) if (fun) funcall(fun); - if (argv) + if (argv) { + val ch_env = child_env; + if (ch_env != t) + replace_env(ch_env); execvp(argv[0], argv); + } _exit(errno); } else { int whichfd; - char *utf8mode = utf8_dup_to(c_str(mode)); - FILE *f; if (input) { close(fd[1]); @@ -4258,28 +4637,26 @@ static val open_subprocess(val name, val mode_str, val args, val fun) fcntl(whichfd, F_SETFD, FD_CLOEXEC); #endif - if ((f = fdopen(whichfd, utf8mode)) == 0) { + uw_simple_catch_begin; + + ret = open_fileno(num(whichfd), mode_str, num(pid)); + + uw_unwind { int status; - kill(pid, SIGINT); - kill(pid, SIGTERM); - while (waitpid(pid, &status, 0) == -1 && errno == EINTR) - ; - free(utf8mode); - uw_throwf(file_error_s, lit("opening pipe ~s, fdopen failed: ~d/~s"), - name, num(errno), string_utf8(strerror(errno)), nao); + if (ret == nil) { + int eno = errno; + kill(pid, SIGINT); + kill(pid, SIGTERM); + while (waitpid(pid, &status, 0) == -1 && errno == EINTR) + ; + uw_ethrowf(file_error_s, lit("opening pipe ~s: ~d/~s"), + name, num(eno), errno_to_str(eno), nao); + } } - free(utf8mode); - /* TODO: catch potential OOM exception here and kill process. */ - ret = set_mode_props(m, make_pipevp_stream(f, name, pid)); + uw_catch_end; } - uw_unwind { - fds_restore(&sfds); - } - - uw_catch_end; - return ret; } @@ -4287,99 +4664,24 @@ val open_process(val name, val mode_str, val args) { return open_subprocess(name, mode_str, args, nil); } -#else - -static void string_extend_count(int count, val out, val tail) -{ - int i; - for (i = 0; i < count; i++) - string_extend(out, tail); -} - -static val win_escape_cmd(val str) -{ - const wchar_t *s; - val out = string(L""); - - for (s = c_str(str); *s; s++) { - switch (*s) { - case ' ': case '\t': - string_extend(out, lit("\"")); - string_extend(out, chr(*s)); - string_extend(out, lit("\"")); - break; - default: - string_extend(out, chr(*s)); - } - } - - return out; -} -static val win_escape_arg(val str) +val open_command(val command, val mode_str) { - int bscount = 0, i; - const wchar_t *s; - val out = string(L""); - - for (s = c_str(str); *s; s++) { - switch (*s) { - case '"': - string_extend_count(bscount, out, lit("\\\\")); - string_extend(out, lit("\\^\"")); - bscount = 0; - break; - case '\\': - bscount++; - break; - case '^': case '%': case '!': - case '\n': case '&': case '|': - case '<': case '>': - case '(': case ')': - for (i = 0; i < bscount; i++) - string_extend_count(bscount, out, lit("\\")); - string_extend(out, chr('^')); - string_extend(out, chr(*s)); - break; - default: - for (i = 0; i < bscount; i++) - string_extend_count(bscount, out, lit("\\")); - string_extend(out, chr(*s)); - bscount = 0; - break; - } - } - - for (i = 0; i < bscount; i++) - string_extend(out, lit("\\")); - - return out; -} - -static val win_make_cmdline(val args) -{ - val out = string(L""); - - string_extend(out, win_escape_cmd(pop(&args))); - string_extend(out, chr(' ')); - - while (args) { - string_extend(out, lit("^\"")); - string_extend(out, win_escape_arg(pop(&args))); - if (args) - string_extend(out, lit("^\" ")); - else - string_extend(out, lit("^\"")); - } - - return out; +#ifdef __CYGWIN__ + uses_or2; + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + val interp = if3(psc[0] == '\\', + or2(getenv_wrap(lit("COMSPEC")), + lit("C:\\WINDOWS\\system32\\cmd.exe")), + lit("/bin/sh")); + val opt = if3(psc[0] == '\\', lit("/c"), lit("-c")); +#else + val interp = lit("/bin/sh"); + val opt = lit("-c"); +#endif + return open_process(interp, mode_str, list(opt, command, nao)); } -val open_process(val name, val mode_str, val args) -{ - val win_cmdline = win_make_cmdline(cons(name, default_null_arg(args))); - return open_command(win_cmdline, mode_str); -} #endif #if HAVE_WSPAWN || HAVE_SPAWN @@ -4415,36 +4717,60 @@ static val run(val command, val args) val iter; int i, nargs, status = 0; struct save_fds sfds; + volatile val save_env, ch_env = child_env; args = default_null_arg(args); - nargs = c_num(length(args)) + 1; + nargs = c_num(length(args), self) + 1; + + flush_stream(std_output); fds_init(&sfds); uw_simple_catch_begin; - fds_swizzle(&sfds, FDS_IN | FDS_OUT | FDS_ERR); + fds_prepare(&sfds, FDS_IN | FDS_OUT | FDS_ERR, self); + + fds_swizzle(&sfds, FDS_IN | FDS_OUT | FDS_ERR, self); if (nargs < 0 || nargs == INT_MAX) uw_throwf(error_s, lit("~a: argument list overflow"), self, nao); + if (ch_env != t) { + save_env = env(); + replace_env(ch_env); + } + wargv = coerce(const wchar_t **, chk_xalloc(nargs + 1, sizeof *wargv, self)); for (i = 0, iter = cons(command, args); iter; i++, iter = cdr(iter)) - wargv[i] = c_str(car(iter)); + wargv[i] = c_str(car(iter), self); wargv[i] = 0; + if (status == 0) { #if HAVE_WSPAWN - status = _wspawnvp(_P_WAIT, c_str(command), wargv); + status = _wspawnvp(_P_WAIT, c_str(command, self), wargv); #else - status = w_spawnvp(_P_WAIT, c_str(command), nargs, wargv); + status = w_spawnvp(_P_WAIT, c_str(command, self), nargs, wargv); #endif +#ifdef __CYGWIN__ + /* Cygwin spawnvp reports regular termination status in upper 8 bits, and + * termination signal in lower 8 bits. Let's massage it so that we produce + * the same behavior as on Linux. + */ + if (status && status < 0x100) + status = -1; /* ensure nil return */ + else + status >>= 8; +#endif + } free(strip_qual(wchar_t **, wargv)); gc_hint(args); uw_unwind { + if (ch_env != t) + replace_env(save_env); fds_restore(&sfds); } @@ -4453,11 +4779,6 @@ static val run(val command, val args) return (status < 0) ? nil : num(status); } -static val sh(val command) -{ - return run(lit("cmd.exe"), list(lit("/C"), command, nao)); -} - #elif HAVE_FORK_STUFF static val run(val name, val args) @@ -4471,7 +4792,7 @@ static val run(val name, val args) val ret = nil; args = default_null_arg(args); - nargs = c_num(length(args)) + 1; + nargs = c_num(length(args), self) + 1; if (nargs < 0 || nargs == INT_MAX) uw_throwf(error_s, lit("~a: argument list overflow"), self, nao); @@ -4480,15 +4801,15 @@ static val run(val name, val args) for (i = 0, iter = cons(name, args); iter; i++, iter = cdr(iter)) { val arg = car(iter); - argv[i] = utf8_dup_to(c_str(arg)); + argv[i] = utf8_dup_to(c_str(arg, self)); } argv[i] = 0; - fds_init(&sfds); + flush_stream(std_output); - uw_simple_catch_begin; + fds_init(&sfds); - fds_swizzle(&sfds, FDS_IN | FDS_OUT | FDS_ERR); + fds_prepare(&sfds, FDS_IN | FDS_OUT | FDS_ERR, self); pid = fork(); @@ -4496,11 +4817,15 @@ static val run(val name, val args) for (i = 0; i < nargs; i++) free(argv[i]); free(argv); - uw_throwf(process_error_s, lit("opening process ~s, fork syscall failed: ~d/~s"), - name, num(errno), string_utf8(strerror(errno)), nao); + uw_ethrowf(process_error_s, lit("opening process ~s, fork syscall failed: ~d/~s"), + name, num(errno), errno_to_str(errno), nao); } if (pid == 0) { + val ch_env = child_env; + fds_clobber(&sfds, FDS_IN | FDS_OUT | FDS_ERR); + if (ch_env != t) + replace_env(ch_env); execvp(argv[0], argv); _exit(errno); } else { @@ -4523,31 +4848,80 @@ static val run(val name, val args) } out: - uw_unwind { - fds_restore(&sfds); - } - - uw_catch_end; - return ret; } +#endif + +#if HAVE_WSPAWN || HAVE_SPAWN || HAVE_FORK_STUFF + static val sh(val command) { return run(shell, list(shell_arg, command, nao)); } -#else -#error port me! #endif +static val sh_esc_dq(val string) +{ + return str_esc(lit("$`\\\""), chr('\\'), string); +} + +static val sh_esc_sq(val string) +{ + return str_esc(lit("'"), lit("'\\'"), string); +} + +static val sh_esc_common(val string, int all, val self) +{ + const wchar_t *s, *str = c_str(string, self); + int sq = 0, dq = 0, es = 0; + + for (s = str; *s; s++) + { + wchar_t ch = *s; + + if (ch == '\'') + es = sq = 1; + else if (wcschr(L"$`\\\"", ch)) + es = dq = 1; + else if (wcschr(L"|&;<>() \t\n*?[#~", ch)) + es = 1; + else if (all && wcschr(L"=%", ch)) + es = 1; + } + + if (!es) + return string; + + if (!dq) + return scat3(chr('"'), string, chr('"')); + + if (!sq) + return scat3(chr('\''), string, chr('\'')); + + return scat3(chr('\''), sh_esc_sq(string), chr('\'')); +} + +static val sh_esc(val string) +{ + return sh_esc_common(string, 0, lit("sh-esc")); +} + +static val sh_esc_all(val string) +{ + return sh_esc_common(string, 1, lit("sh-esc-all")); +} + val remove_path(val path, val throw_on_error) { - if (w_remove(c_str(path)) < 0) { + val self = lit("remove-path"); + + if (w_remove(c_str(path, self)) < 0) { if (default_null_arg(throw_on_error) || errno != ENOENT) { int eno = errno; - uw_throwf(errno_to_file_error(eno), lit("trying to remove ~s: ~d/~s"), - path, num(eno), string_utf8(strerror(eno)), nao); + uw_ethrowf(errno_to_file_error(eno), lit("trying to remove ~s: ~d/~s"), + path, num(eno), errno_to_str(eno), nao); } return nil; } @@ -4557,11 +4931,13 @@ val remove_path(val path, val throw_on_error) val rename_path(val from, val to) { - if (w_rename(c_str(from), c_str(to)) < 0) { + val self = lit("rename-path"); + + if (w_rename(c_str(from, self), c_str(to, self)) < 0) { int eno = errno; - uw_throwf(errno_to_file_error(eno), - lit("trying to rename ~s to ~s: ~d/~s"), - from, to, num(eno), string_utf8(strerror(eno)), nao); + uw_ethrowf(errno_to_file_error(eno), + lit("trying to rename ~s to ~s: ~d/~s"), + from, to, num(eno), errno_to_str(eno), nao); } return t; @@ -4597,50 +4973,91 @@ static val open_files_star(val file_list, val substitute_stream, val mode) } } -static val ap_regex; +static val volume_prefix_p(const wchar_t *str) +{ + enum { init, slash } state; -val abs_path_p(val path) + for (state = init; *str; str++) { + wchar_t ch = *str; + switch (state) { + case init: + if (iswalnum(ch)) + continue; + if (ch == ':') { + state = slash; + continue; + } + return nil; + case slash: + if (ch == '/' || ch == '\\') + return t; + return nil; + } + } + + return nil; +} + +static val volume_name_p(const wchar_t *str) { - val ch; + for (; *str; str++) { + if (iswalnum(*str)) + continue; + if (*str == ':') + return t; + break; + } + + return nil; +} - if (length(path) == zero) +val portable_abs_path_p(val path) +{ + val self = lit("portable-abs-path-p"); + const wchar_t *str = c_str(path, self); + + if (*str == 0) return nil; - if ((ch = chr_str(path, zero)) == chr('/') || ch == chr('\\')) + if (str[0] == '/' || str[0] == '\\') return t; + return volume_prefix_p(str); +} - if (!ap_regex) - ap_regex = regex_compile(lit("[A-Za-z0-9]+:[/\\\\]"), nil); +val abs_path_p(val path) +{ + val self = lit("abs-path-p"); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + const wchar_t *str = c_str(path, self); - if (match_regex(path, ap_regex, zero)) + if (*str == 0) + return nil; + if (wcschr(psc, str[0])) return t; - return nil; -} + if (psc[0] != '\\') + return nil; -static val plp_regex; + return volume_prefix_p(str); +} val pure_rel_path_p(val path) { - val ch; - val len = length_str(path); + val self = lit("pure-rel-path-p"); + const wchar_t *str = c_str(path, self); - if (len == zero) + if (str[0] == 0) return t; - if ((ch = chr_str(path, zero)) == chr('/') || ch == chr('\\')) + if (str[0] == '/' || str[0] == '\\') return nil; - if (len == one) - return ch == chr('.') ? nil : t; + if (str[1] == 0) + return str[0] == '.' ? nil : t; - if (ch == chr('.') && - ((ch = chr_str(path, one)) == chr('/') || ch == chr('\\'))) + if (str[0] == '.' && (str[1] == '/' || str[1] == '\\')) return nil; - if (!plp_regex) - plp_regex = regex_compile(lit("[A-Za-z0-9]+:"), nil); - - if (match_regex(path, plp_regex, zero)) + if (volume_name_p(str)) return nil; return t; @@ -4652,19 +5069,21 @@ static void detect_path_separators(void) struct utsname un; if (uname(&un) >= 0) { - if (strncmp(un.sysname, "CYGNAL", 6) == 0) + if (strncmp(un.sysname, "CYGNAL", 6) == 0) { path_sep_chars = wli("\\/"); - return; + path_var_sep_char = ';'; + } } #endif } val base_name(val path, val suff) { - const wchar_t *wpath = c_str(path); - const wchar_t *end = wpath + c_num(length_str(path)); + val self = lit("base-name"); + const wchar_t *wpath = c_str(path, self); + const wchar_t *end = wpath + c_num(length_str(path), self); const wchar_t *rsep; - const wchar_t *psc = wref(coerce(const wchar_t *, path_sep_chars)); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); if (end == wpath) return null_string; @@ -4683,9 +5102,9 @@ val base_name(val path, val suff) { val base = mkustring(num_fast(end - rsep)); - init_str(base, rsep); + init_str(base, rsep, self); return if3(!null_or_missing_p(suff) && ends_with(suff, base, nil, nil) && - neql(length(suff), length(base)), + plusp(length(suff)) && neql(length(suff), length(base)), sub(base, zero, neg(length(suff))), base); } @@ -4693,9 +5112,10 @@ val base_name(val path, val suff) val dir_name(val path) { - const wchar_t *wpath = c_str(path); - const wchar_t *rsep = wpath + c_num(length_str(path)); - const wchar_t *psc = wref(coerce(const wchar_t *, path_sep_chars)); + val self = lit("dir-name"); + const wchar_t *wpath = c_str(path, self); + const wchar_t *rsep = wpath + c_num(length_str(path), self); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); if (rsep == wpath) return lit("."); @@ -4722,14 +5142,187 @@ val dir_name(val path) { val base = mkustring(num_fast(rsep - wpath - 1)); - return init_str(base, wpath); + return init_str(base, wpath, self); + } +} + +val short_suffix(val name, val alt_in) +{ + val self = lit("short-suffix"); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + const wchar_t *str = c_str(name, self); + const wchar_t *dot = wcsrchr(str, '.'); + const wchar_t *sl = if3(dot, wcspbrk(dot + 1, psc), 0); + int sl_trail = if3(sl, sl[wcsspn(sl, psc)] == 0, 0); + + if (!dot || (sl && sl[1] && !sl_trail) || dot == str || wcschr(psc, dot[-1])) { + return default_null_arg(alt_in); + } else { + wchar_t *suff = chk_strdup(dot); + if (sl) + suff[sl - dot] = 0; + return string_own(suff); + } +} + +val long_suffix(val name, val alt_in) +{ + val self = lit("long-suffix"); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + const wchar_t *str = c_str(name, self); + const wchar_t *dot = wcschr(str, '.'); + + { + const wchar_t *sl; + + while (dot && (sl = wcspbrk(dot, psc)) && sl[1] && sl[wcsspn(sl, psc)] != 0) + dot = wcschr(sl + 1, '.'); + + if (dot && (dot == str || wcschr(psc, dot[-1]))) + dot = wcschr(dot + 1, '.'); + + if (!dot || dot == str) { + return default_null_arg(alt_in); + } else { + wchar_t *suff = chk_strdup(dot); + if (sl) + suff[sl - dot] = 0; + return string_own(suff); + } + } +} + +val trim_short_suffix(val name) +{ + val self = lit("trim-short-suffix"); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + const wchar_t *str = c_str(name, self); + const wchar_t *dot = wcsrchr(str, '.'); + const wchar_t *sl = if3(dot, wcspbrk(dot + 1, psc), 0); + int sl_trail = if3(sl, sl[wcsspn(sl, psc)] == 0, 0); + + if (!dot || (sl && sl[1] && !sl_trail) || dot == str || wcschr(psc, dot[-1])) { + return name; + } else { + size_t off = dot - str; + if (sl) { + size_t slsz = wcslen(sl) + 1; + size_t nchar = off + slsz; + wchar_t *out = chk_wmalloc(nchar); + wmemcpy(out, str, off); + wmemcpy(out + off, sl, slsz); + return string_own(out); + } else { + wchar_t *pref = chk_substrdup(str, 0, dot - str); + return string_own(pref); + } + } +} + +val trim_long_suffix(val name) +{ + val self = lit("trim-long-suffix"); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + const wchar_t *str = c_str(name, self); + const wchar_t *dot = wcschr(str, '.'); + + { + const wchar_t *sl; + + while (dot && (sl = wcspbrk(dot, psc)) && sl[1] && sl[wcsspn(sl, psc)] != 0) + dot = wcschr(sl + 1, '.'); + + if (dot && (dot == str || wcschr(psc, dot[-1]))) + dot = wcschr(dot + 1, '.'); + + if (!dot || dot == str) { + return name; + } else { + size_t off = dot - str; + if (sl) { + size_t slsz = wcslen(sl) + 1; + size_t nchar = off + slsz; + wchar_t *out = chk_wmalloc(nchar); + wmemcpy(out, str, off); + wmemcpy(out + off, sl, slsz); + return string_own(out); + } else { + wchar_t *pref = chk_substrdup(str, 0, dot - str); + return string_own(pref); + } + } + } +} + +val trim_path_seps(val name) +{ + val self = lit("trim-path-seps"); + const wchar_t *str = c_str(name, self); + const wchar_t *psc = L"/\\"; + const wchar_t *fsl = 0; + cnum len = c_num(length_str(name), self); + + if (portable_abs_path_p(name)) + fsl = wcspbrk(str, psc); + + while (len-- > 0) + if (!wcschr(psc, str[len]) || str + len == fsl) + break; + + return string_own(chk_substrdup(str, 0, len + 1)); +} + +val add_suffix(val name, val suffix) +{ + val self = lit("add-suffix"); + size_t len_n = c_unum(length_str(name), self); + size_t len_s = c_unum(length_str(suffix), self); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + const wchar_t *nam = c_str(name, self); + const wchar_t *suf = c_str(suffix, self); + const wchar_t *sl = wcspbrk(nam, psc); + + if (psc[0] == '\\' || 1) { + const wchar_t *set = L"ABCDEFGHIJKLMNOPQRSTUVWXYZ" + L"abcdefghijklmnopqrstuvwxyz" + L"0123456789"; + const wchar_t *drv = nam + wcsspn(nam, set); + if (drv[0] == ':' && sl == drv + 1) { + if (drv - nam > 1) { + if (wcschr(psc, drv[2])) + sl = wcspbrk(drv + 3, psc); + } else if (drv > nam) { + sl = wcspbrk(drv + 2, psc); + } + } + } + + if (sl == nam) + sl = wcspbrk(nam + 1, psc); + + while (sl) { + const wchar_t *nsl = sl + 1 + wcsspn(sl + 1, psc); + + if (*nsl == 0) { + size_t nchar = len_n + len_s + 1; + size_t offs = sl - nam; + wchar_t *out = chk_wmalloc(nchar); + wmemcpy(out, nam, offs); + wmemcpy(out + offs, suf, len_s); + wcscpy(out + offs + len_s, sl); + return string_own(out); + } + + sl = wcspbrk(nsl, psc); } + + return scat2(name, suffix); } val path_cat(val dir_name, val base_name) { - val dl = length(dir_name); - val bl = length(base_name); + val dl = length_str(dir_name); + val bl = length_str(base_name); val ps = static_str(path_sep_chars); if (dl == zero) @@ -4765,6 +5358,25 @@ val path_cat(val dir_name, val base_name) return scat(lit("/"), dir_name, base_name, nao); } +static val path_vcat(varg args) +{ + cnum ix = 0; + + if (!args_more(args, ix)) { + return lit("."); + } else { + val accum = args_get(args, &ix); + + if (!stringp(accum)) + uw_throwf(file_error_s, lit("path-cat: ~s isn't a string"), accum, nao); + + while (args_more(args, ix)) + accum = path_cat(accum, args_get(args, &ix)); + + return accum; + } +} + val make_byte_input_stream(val obj) { val self = lit("make-byte-input-stream"); @@ -4782,6 +5394,72 @@ val make_byte_input_stream(val obj) } } +val tmpfile_wrap(void) +{ + val self = lit("tmpfile"); + struct stdio_mode m_blank = stdio_mode_init_blank; + struct stdio_mode m = do_parse_mode(lit("w+b"), m_blank, self); + FILE *tf = tmpfile(); + if (tf != 0) + return set_mode_props(m, make_stdio_stream(tf, self)); + uw_ethrowf(file_error_s, lit("~a failed: ~d/~s"), + self, num(errno), errno_to_str(errno), nao); +} + +#if HAVE_MKDTEMP + +val mkdtemp_wrap(val prefix) +{ + val self = lit("mkdtemp"); + char *tmpl = utf8_dup_to(c_str(scat2(prefix, lit("XXXXXX")), self)); + + if (mkdtemp(tmpl) != 0) { + val ret = string_utf8(tmpl); + free(tmpl); + return ret; + } + + free(tmpl); + uw_ethrowf(file_error_s, lit("mkdtemp failed: ~d/~s"), + num(errno), errno_to_str(errno), nao); +} + +#endif + +#if HAVE_MKSTEMP + +val mkstemp_wrap(val prefix, val suffix) +{ + val self = lit("mkstemp"); + val suff = default_arg_strict(suffix, null_string); + val templ = scat3(prefix, lit("XXXXXX"), suff); + cnum slen = c_num(length(suff), self); + char *tmpl = utf8_dup_to(c_str(templ, self)); + val name; + int fd; + +#if HAVE_MKSTEMPS + fd = mkstemps(tmpl, slen); +#else + if (slen > 0) { + free(tmpl); + uw_throwf(system_error_s, lit("~a: suffix not supported"), self, nao); + } + fd = mkstemp(tmpl); +#endif + name = string_utf8(tmpl); + free(tmpl); + if (fd != -1) { + val stream = open_fileno(num(fd), lit("w+b"), nil); + stream_set_prop(stream, name_k, name); + return stream; + } + uw_ethrowf(file_error_s, lit("~a failed: ~d/~s"), + self, num(errno), errno_to_str(errno), nao); +} + +#endif + static val iobuf_free_list; val iobuf_get(void) @@ -4811,8 +5489,7 @@ void iobuf_list_empty(void) void stream_init(void) { - prot1(&ap_regex); - prot1(&plp_regex); + prot1(&top_stderr); detect_format_string(); detect_path_separators(); @@ -4825,6 +5502,7 @@ void stream_init(void) addr_k = intern(lit("addr"), keyword_package); fd_k = intern(lit("fd"), keyword_package); byte_oriented_k = intern(lit("byte-oriented"), keyword_package); + standard_k = intern(lit("standard"), keyword_package); format_s = intern(lit("format"), user_package); stdio_stream_s = intern(lit("stdio-stream"), user_package); #if HAVE_SOCKETS @@ -4851,6 +5529,9 @@ void stream_init(void) clear_error_s = intern(lit("clear-error"), user_package); get_fd_s = intern(lit("get-fd"), user_package); + stream_cls = cobj_register(stream_s); + stdio_stream_cls = cobj_register_super(stdio_stream_s, stream_cls); + reg_var(stdin_s = intern(lit("*stdin*"), user_package), make_stdio_stream(stdin, lit("stdin"))); reg_var(stdout_s = intern(lit("*stdout*"), user_package), @@ -4858,7 +5539,7 @@ void stream_init(void) reg_var(stddebug_s = intern(lit("*stddebug*"), user_package), make_stdio_stream(stdout, lit("debug"))); reg_var(stderr_s = intern(lit("*stderr*"), user_package), - make_stdio_stream(stderr, lit("stderr"))); + top_stderr = make_stdio_stream(stderr, lit("stderr"))); reg_var(stdnull_s = intern(lit("*stdnull*"), user_package), make_null_stream()); @@ -4877,6 +5558,7 @@ void stream_init(void) reg_var(print_base_s = intern(lit("*print-base*"), user_package), num_fast(10)); reg_var(print_circle_s = intern(lit("*print-circle*"), user_package), nil); + reg_var(print_json_format_s = intern(lit("*print-json-format*"), user_package), nil); #if HAVE_ISATTY if (isatty(fileno(stdin)) == 1) { @@ -4913,6 +5595,7 @@ void stream_init(void) reg_fun(unget_byte_s, func_n2o(unget_byte, 1)); reg_fun(put_buf_s, func_n3o(put_buf, 1)); reg_fun(fill_buf_s, func_n3o(fill_buf, 1)); + reg_fun(intern(lit("get-line-as-buf"), user_package), func_n1o(get_line_as_buf, 0)); reg_fun(intern(lit("fill-buf-adjust"), user_package), func_n3o(fill_buf_adjust, 1)); reg_fun(intern(lit("flush-stream"), user_package), func_n1o(flush_stream, 0)); reg_fun(intern(lit("seek-stream"), user_package), func_n3(seek_stream)); @@ -4935,25 +5618,39 @@ void stream_init(void) reg_fun(intern(lit("record-adapter"), user_package), func_n3o(record_adapter, 1)); reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory)); reg_fun(intern(lit("open-file"), user_package), func_n2o(open_file, 1)); - reg_fun(intern(lit("open-fileno"), user_package), func_n2o(open_fileno, 1)); + reg_fun(intern(lit("open-fileno"), user_package), func_n3o(open_fileno, 1)); reg_fun(intern(lit("open-tail"), user_package), func_n3o(open_tail, 1)); + reg_fun(intern(lit("path-search"), user_package), func_n2o(path_search, 1)); reg_fun(intern(lit("open-command"), user_package), func_n2o(open_command, 1)); reg_fun(intern(lit("open-pipe"), user_package), func_n2(open_command)); reg_fun(intern(lit("open-process"), user_package), func_n3o(open_process, 2)); #if HAVE_FORK_STUFF reg_fun(intern(lit("open-subprocess"), user_package), func_n4o(open_subprocess, 2)); #endif +#if HAVE_WSPAWN || HAVE_SPAWN || HAVE_FORK_STUFF reg_fun(intern(lit("sh"), user_package), func_n1(sh)); reg_fun(intern(lit("run"), user_package), func_n2o(run, 1)); +#endif + reg_fun(intern(lit("sh-esc"), user_package), func_n1(sh_esc)); + reg_fun(intern(lit("sh-esc-all"), user_package), func_n1(sh_esc_all)); + reg_fun(intern(lit("sh-esc-dq"), user_package), func_n1(sh_esc_dq)); + reg_fun(intern(lit("sh-esc-sq"), user_package), func_n1(sh_esc_sq)); reg_fun(intern(lit("remove-path"), user_package), func_n2o(remove_path, 1)); reg_fun(intern(lit("rename-path"), user_package), func_n2(rename_path)); reg_fun(intern(lit("open-files"), user_package), func_n3o(open_files, 1)); reg_fun(intern(lit("open-files*"), user_package), func_n3o(open_files_star, 1)); + reg_fun(intern(lit("portable-abs-path-p"), user_package), func_n1(portable_abs_path_p)); reg_fun(intern(lit("abs-path-p"), user_package), func_n1(abs_path_p)); reg_fun(intern(lit("pure-rel-path-p"), user_package), func_n1(pure_rel_path_p)); reg_fun(intern(lit("base-name"), user_package), func_n2o(base_name, 1)); reg_fun(intern(lit("dir-name"), user_package), func_n1(dir_name)); - reg_fun(intern(lit("path-cat"), user_package), func_n2(path_cat)); + reg_fun(intern(lit("short-suffix"), user_package), func_n2o(short_suffix, 1)); + reg_fun(intern(lit("long-suffix"), user_package), func_n2o(long_suffix, 1)); + reg_fun(intern(lit("trim-short-suffix"), user_package), func_n1(trim_short_suffix)); + reg_fun(intern(lit("trim-long-suffix"), user_package), func_n1(trim_long_suffix)); + reg_fun(intern(lit("trim-path-seps"), user_package), func_n1(trim_path_seps)); + reg_fun(intern(lit("path-cat"), user_package), func_n0v(path_vcat)); + reg_fun(intern(lit("add-suffix"), user_package), func_n2(add_suffix)); reg_varl(intern(lit("path-sep-chars"), user_package), static_str(path_sep_chars)); reg_fun(intern(lit("get-indent-mode"), user_package), func_n1(get_indent_mode)); reg_fun(intern(lit("test-set-indent-mode"), user_package), func_n3(test_set_indent_mode)); @@ -4962,6 +5659,7 @@ void stream_init(void) reg_fun(intern(lit("get-indent"), user_package), func_n1(get_indent)); reg_fun(intern(lit("set-indent"), user_package), func_n2(set_indent)); reg_fun(intern(lit("inc-indent"), user_package), func_n2(inc_indent)); + reg_fun(intern(lit("inc-indent-abs"), user_package), func_n2(inc_indent_abs)); reg_fun(intern(lit("width-check"), user_package), func_n2(width_check)); reg_fun(intern(lit("force-break"), user_package), func_n1(force_break)); reg_fun(intern(lit("set-max-length"), user_package), func_n2(set_max_length)); @@ -4970,6 +5668,13 @@ void stream_init(void) reg_varl(intern(lit("indent-data"), user_package), num_fast(indent_data)); reg_varl(intern(lit("indent-code"), user_package), num_fast(indent_code)); reg_varl(intern(lit("indent-foff"), user_package), num_fast(indent_foff)); + reg_fun(intern(lit("tmpfile"), user_package), func_n0(tmpfile_wrap)); +#if HAVE_MKDTEMP + reg_fun(intern(lit("mkdtemp"), user_package), func_n1(mkdtemp_wrap)); +#endif +#if HAVE_MKSTEMP + reg_fun(intern(lit("mkstemp"), user_package), func_n2o(mkstemp_wrap, 1)); +#endif #if HAVE_SOCKETS uw_register_subtype(socket_error_s, error_s); @@ -4978,7 +5683,9 @@ void stream_init(void) fill_stream_ops(&null_ops); fill_stream_ops(&stdio_ops); fill_stream_ops(&tail_ops); +#if HAVE_FORK_STUFF fill_stream_ops(&pipe_ops); +#endif fill_stream_ops(&string_in_ops); fill_stream_ops(&byte_in_ops); fill_stream_ops(&strlist_in_ops); @@ -5017,4 +5724,15 @@ void stream_init(void) } } #endif + +#if HAVE_ZLIB + gzio_init(); +#endif +} + +void stream_compat_fixup(int compat_ver) +{ + if (compat_ver <= 258) + reg_fun(intern(lit("abs-path-p"), user_package), + func_n1(portable_abs_path_p)); } |