From 84c2866b2baf9cb5205290f3f33f0e2983ca2832 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 19 Feb 2016 05:54:50 +0900 Subject: [PATCH] cleanup port API --- contrib/20.r7rs/src/file.c | 37 +-- contrib/20.r7rs/src/load.c | 10 +- contrib/20.r7rs/t/r7rs.scm | 2 + contrib/40.srfi/src/106.c | 19 +- extlib/benz/char.c | 2 +- extlib/benz/file.c | 192 +++++++++++++ extlib/benz/include/picrin.h | 6 +- extlib/benz/include/picrin/file.h | 7 + extlib/benz/include/picrin/port.h | 15 +- extlib/benz/load.c | 4 +- extlib/benz/number.c | 13 +- extlib/benz/port.c | 435 +++++------------------------- extlib/benz/read.c | 2 +- extlib/benz/state.c | 12 +- extlib/benz/string.c | 16 +- 15 files changed, 331 insertions(+), 441 deletions(-) diff --git a/contrib/20.r7rs/src/file.c b/contrib/20.r7rs/src/file.c index 619f8dba..83fd231f 100644 --- a/contrib/20.r7rs/src/file.c +++ b/contrib/20.r7rs/src/file.c @@ -12,48 +12,35 @@ file_error(pic_state *pic, const char *msg) pic_error(pic, "file", msg, pic_nil_value(pic)); } -pic_value -pic_file_open_input_file(pic_state *pic) +static struct pic_port * +open_file(pic_state *pic, const char *fname, const char *mode) { - static const short flags = PIC_PORT_IN; - char *fname; + FILE *fp; - pic_get_args(pic, "z", &fname); - - return pic_obj_value(pic_open_file(pic, fname, flags)); + if ((fp = fopen(fname, mode)) == NULL) { + file_error(pic, "could not open file..."); + } + return pic_make_port(pic, xfopen_file(pic, fp, mode)); } pic_value -pic_file_open_binary_input_file(pic_state *pic) +pic_file_open_input_file(pic_state *pic) { - static const short flags = PIC_PORT_IN; char *fname; pic_get_args(pic, "z", &fname); - return pic_obj_value(pic_open_file(pic, fname, flags)); + return pic_obj_value(open_file(pic, fname, "r")); } pic_value pic_file_open_output_file(pic_state *pic) { - static const short flags = PIC_PORT_OUT; char *fname; pic_get_args(pic, "z", &fname); - return pic_obj_value(pic_open_file(pic, fname, flags)); -} - -pic_value -pic_file_open_binary_output_file(pic_state *pic) -{ - static const short flags = PIC_PORT_OUT; - char *fname; - - pic_get_args(pic, "z", &fname); - - return pic_obj_value(pic_open_file(pic, fname, flags)); + return pic_obj_value(open_file(pic, fname, "w")); } pic_value @@ -92,9 +79,9 @@ pic_init_file(pic_state *pic) pic_deflibrary(pic, "scheme.file"); pic_defun(pic, "open-input-file", pic_file_open_input_file); - pic_defun(pic, "open-binary-input-file", pic_file_open_binary_input_file); + pic_defun(pic, "open-binary-input-file", pic_file_open_input_file); pic_defun(pic, "open-output-file", pic_file_open_output_file); - pic_defun(pic, "open-binary-output-file", pic_file_open_binary_output_file); + pic_defun(pic, "open-binary-output-file", pic_file_open_output_file); pic_defun(pic, "file-exists?", pic_file_exists_p); pic_defun(pic, "delete-file", pic_file_delete); } diff --git a/contrib/20.r7rs/src/load.c b/contrib/20.r7rs/src/load.c index 1f39e0b3..15004dc0 100644 --- a/contrib/20.r7rs/src/load.c +++ b/contrib/20.r7rs/src/load.c @@ -4,16 +4,24 @@ #include "picrin.h" +#include + static pic_value pic_load_load(pic_state *pic) { pic_value envid; char *fn; struct pic_port *port; + FILE *fp; pic_get_args(pic, "z|o", &fn, &envid); - port = pic_open_file(pic, fn, PIC_PORT_IN); + fp = fopen(fn, "r"); + if (fp == NULL) { + pic_errorf(pic, "load: could not open file %s", fn); + } + + port = pic_make_port(pic, xfopen_file(pic, fp, "r")); pic_load(pic, port); diff --git a/contrib/20.r7rs/t/r7rs.scm b/contrib/20.r7rs/t/r7rs.scm index 4185724d..f329d781 100644 --- a/contrib/20.r7rs/t/r7rs.scm +++ b/contrib/20.r7rs/t/r7rs.scm @@ -1766,6 +1766,8 @@ (test 'exception value) (test "condition: an-error!" (get-output-string out))) +(flush-output-port) + (define (test-exception-handler-4 v out) (call-with-current-continuation (lambda (k) diff --git a/contrib/40.srfi/src/106.c b/contrib/40.srfi/src/106.c index a6cd8da6..c8efc474 100644 --- a/contrib/40.srfi/src/106.c +++ b/contrib/40.srfi/src/106.c @@ -327,14 +327,17 @@ xf_socket_close(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie)) } static struct pic_port * -make_socket_port(pic_state *pic, struct pic_socket_t *sock, short dir) +make_socket_port(pic_state *pic, struct pic_socket_t *sock, const char *mode) { - struct pic_port *port; + xFILE *fp; - port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT); - port->file = xfunopen(pic, sock, xf_socket_read, xf_socket_write, xf_socket_seek, xf_socket_close); - port->flags = dir | PIC_PORT_OPEN; - return port; + if (*mode == 'r') { + fp = xfunopen(pic, sock, xf_socket_read, 0, xf_socket_seek, xf_socket_close); + } else { + fp = xfunopen(pic, sock, 0, xf_socket_write, xf_socket_seek, xf_socket_close); + } + + return pic_make_port(pic, fp); } static pic_value @@ -349,7 +352,7 @@ pic_socket_socket_input_port(pic_state *pic) sock = pic_socket_data(pic, obj); ensure_socket_is_open(pic, sock); - return pic_obj_value(make_socket_port(pic, sock, PIC_PORT_IN)); + return pic_obj_value(make_socket_port(pic, sock, "r")); } static pic_value @@ -364,7 +367,7 @@ pic_socket_socket_output_port(pic_state *pic) sock = pic_socket_data(pic, obj); ensure_socket_is_open(pic, sock); - return pic_obj_value(make_socket_port(pic, sock, PIC_PORT_OUT)); + return pic_obj_value(make_socket_port(pic, sock, "w")); } static pic_value diff --git a/extlib/benz/char.c b/extlib/benz/char.c index 709787fb..d4d4b499 100644 --- a/extlib/benz/char.c +++ b/extlib/benz/char.c @@ -31,7 +31,7 @@ pic_char_integer_to_char(pic_state *pic) pic_get_args(pic, "i", &i); - if (i < 0 || i > 127) { + if (i < 0 || i > 255) { pic_errorf(pic, "integer->char: integer out of char range: %d", i); } diff --git a/extlib/benz/file.c b/extlib/benz/file.c index 334a4315..4b4b274e 100644 --- a/extlib/benz/file.c +++ b/extlib/benz/file.c @@ -378,6 +378,198 @@ int xvfprintf(pic_state *pic, xFILE *stream, const char *fmt, va_list ap) { return cnt; } +#if PIC_ENABLE_STDIO + +static int +file_read(pic_state PIC_UNUSED(*pic), void *cookie, char *ptr, int size) { + FILE *file = cookie; + int r; + + size = 1; /* override size */ + + r = (int)fread(ptr, 1, (size_t)size, file); + if (r < size && ferror(file)) { + return -1; + } + if (r == 0 && feof(file)) { + clearerr(file); + } + return r; +} + +static int +file_write(pic_state PIC_UNUSED(*pic), void *cookie, const char *ptr, int size) { + FILE *file = cookie; + int r; + + r = (int)fwrite(ptr, 1, (size_t)size, file); + if (r < size) { + return -1; + } + fflush(cookie); + return r; +} + +static long +file_seek(pic_state PIC_UNUSED(*pic), void *cookie, long pos, int whence) { + switch (whence) { + case XSEEK_CUR: + whence = SEEK_CUR; + break; + case XSEEK_SET: + whence = SEEK_SET; + break; + case XSEEK_END: + whence = SEEK_END; + break; + } + if (fseek(cookie, pos, whence) == 0) { + return ftell(cookie); + } + return -1; +} + +static int +file_close(pic_state PIC_UNUSED(*pic), void *cookie) { + return fclose(cookie); +} + +xFILE *xfopen_file(pic_state *pic, FILE *fp, const char *mode) { + switch (*mode) { + case 'r': + return xfunopen(pic, fp, file_read, 0, file_seek, file_close); + default: + return xfunopen(pic, fp, 0, file_write, file_seek, file_close); + } +} + +#endif + +typedef struct { char *buf; long pos, end, capa; } xbuf_t; + +static int +string_read(pic_state PIC_UNUSED(*pic), void *cookie, char *ptr, int size) +{ + xbuf_t *m = cookie; + + if (size > (int)(m->end - m->pos)) + size = (int)(m->end - m->pos); + memcpy(ptr, m->buf + m->pos, size); + m->pos += size; + return size; +} + +static int +string_write(pic_state *pic, void *cookie, const char *ptr, int size) +{ + xbuf_t *m = cookie; + + if (m->pos + size >= m->capa) { + m->capa = (m->pos + size) * 2; + m->buf = pic_realloc(pic, m->buf, m->capa); + } + memcpy(m->buf + m->pos, ptr, size); + m->pos += size; + if (m->end < m->pos) + m->end = m->pos; + return size; +} + +static long +string_seek(pic_state PIC_UNUSED(*pic), void *cookie, long pos, int whence) +{ + xbuf_t *m = cookie; + + switch (whence) { + case XSEEK_SET: + m->pos = pos; + break; + case XSEEK_CUR: + m->pos += pos; + break; + case XSEEK_END: + m->pos = m->end + pos; + break; + } + + return m->pos; +} + +static int +string_close(pic_state *pic, void *cookie) +{ + xbuf_t *m = cookie; + + pic_free(pic, m->buf); + pic_free(pic, m); + return 0; +} + +xFILE *xfopen_buf(pic_state *pic, const char *data, int size, const char *mode) { + xbuf_t *m; + xFILE *file; + + m = pic_malloc(pic, sizeof(xbuf_t)); + m->buf = pic_malloc(pic, size); + m->pos = 0; + m->end = size; + m->capa = size; + + if (*mode == 'r') { + memcpy(m->buf, data, size); + file = xfunopen(pic, m, string_read, NULL, string_seek, string_close); + } else { + file = xfunopen(pic, m, NULL, string_write, string_seek, string_close); + } + if (file == NULL) { + string_close(pic, m); + } + return file; +} + +int xfget_buf(pic_state *pic, xFILE *file, const char **buf, int *len) { + xbuf_t *s; + + xfflush(pic, file); + + if (file->vtable.write != string_write) { + return -1; + } + s = file->vtable.cookie; + *len = s->end; + *buf = s->buf; + return 0; +} + +static int +null_read(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie), char PIC_UNUSED(*ptr), int PIC_UNUSED(size)) { + return 0; +} + +static int +null_write(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie), const char PIC_UNUSED(*ptr), int size) { + return size; +} + +static long +null_seek(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie), long PIC_UNUSED(pos), int PIC_UNUSED(whence)) { + return 0; +} + +static int +null_close(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie)) { + return 0; +} + +xFILE *xfopen_null(pic_state PIC_UNUSED(*pic), const char *mode) { + switch (*mode) { + case 'r': + return xfunopen(pic, 0, null_read, 0, null_seek, null_close); + default: + return xfunopen(pic, 0, 0, null_write, null_seek, null_close); + } +} + #if 0 int main() { diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 71d5ed2e..a2944b44 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -350,9 +350,9 @@ void pic_warnf(pic_state *, const char *, ...); struct pic_string *pic_get_backtrace(pic_state *); void pic_print_backtrace(pic_state *, xFILE *); -struct pic_port *pic_stdin(pic_state *); -struct pic_port *pic_stdout(pic_state *); -struct pic_port *pic_stderr(pic_state *); +#define pic_stdin(pic) pic_port_ptr(pic_funcall(pic, "picrin.base", "current-input-port", 0)) +#define pic_stdout(pic) pic_port_ptr(pic_funcall(pic, "picrin.base", "current-output-port", 0)) +#define pic_stderr(pic) pic_port_ptr(pic_funcall(pic, "picrin.base", "current-error-port", 0)) pic_value pic_write(pic_state *, pic_value); /* returns given obj */ pic_value pic_fwrite(pic_state *, pic_value, xFILE *); diff --git a/extlib/benz/include/picrin/file.h b/extlib/benz/include/picrin/file.h index 55a123b1..d23479ad 100644 --- a/extlib/benz/include/picrin/file.h +++ b/extlib/benz/include/picrin/file.h @@ -62,6 +62,13 @@ enum _flags { xFILE *xfunopen(pic_state *, void *cookie, int (*read)(pic_state *, void *, char *, int), int (*write)(pic_state *, void *, const char *, int), long (*seek)(pic_state *, void *, long, int), int (*close)(pic_state *, void *)); int xfclose(pic_state *, xFILE *); +#if PIC_ENABLE_STDIO +xFILE *xfopen_file(pic_state *, FILE *, const char *mode); +#endif +xFILE *xfopen_buf(pic_state *, const char *buf, int len, const char *mode); +int xfget_buf(pic_state *, xFILE *file, const char **buf, int *len); +xFILE *xfopen_null(pic_state *, const char *mode); + /* buffer management */ int x_fillbuf(pic_state *, xFILE *); int x_flushbuf(pic_state *, int, xFILE *); diff --git a/extlib/benz/include/picrin/port.h b/extlib/benz/include/picrin/port.h index c1bc8225..95ddc487 100644 --- a/extlib/benz/include/picrin/port.h +++ b/extlib/benz/include/picrin/port.h @@ -9,26 +9,15 @@ extern "C" { #endif -enum pic_port_flag { - PIC_PORT_IN = 1, - PIC_PORT_OUT = 2, - PIC_PORT_OPEN = 16 -}; - struct pic_port { PIC_OBJECT_HEADER xFILE *file; - int flags; }; #define pic_port_ptr(v) ((struct pic_port *)pic_obj_ptr(v)) -struct pic_port *pic_open_input_string(pic_state *, const char *); -struct pic_port *pic_open_output_string(pic_state *); -struct pic_string *pic_get_output_string(pic_state *, struct pic_port *); - -struct pic_port *pic_open_file(pic_state *, const char *, int); -void pic_close_port(pic_state *pic, struct pic_port *); +struct pic_port *pic_make_port(pic_state *, xFILE *file); +void pic_close_port(pic_state *, struct pic_port *port); #if defined(__cplusplus) } diff --git a/extlib/benz/load.c b/extlib/benz/load.c index f1a8f26c..f055a2d1 100644 --- a/extlib/benz/load.c +++ b/extlib/benz/load.c @@ -18,9 +18,9 @@ pic_load(pic_state *pic, struct pic_port *port) } void -pic_load_cstr(pic_state *pic, const char *src) +pic_load_cstr(pic_state *pic, const char *str) { - struct pic_port *port = pic_open_input_string(pic, src); + struct pic_port *port = pic_make_port(pic, xfopen_buf(pic, str, strlen(str), "r")); pic_try { pic_load(pic, port); diff --git a/extlib/benz/number.c b/extlib/benz/number.c index 423c8287..7821db08 100644 --- a/extlib/benz/number.c +++ b/extlib/benz/number.c @@ -239,13 +239,14 @@ pic_number_number_to_string(pic_state *pic) pic_free(pic, buf); } else { - struct pic_port *port = pic_open_output_string(pic); + xFILE *file = xfopen_buf(pic, NULL, 0, "w"); + const char *buf; + int len; - xfprintf(pic, port->file, "%f", f); - - str = pic_get_output_string(pic, port); - - pic_close_port(pic, port); + xfprintf(pic, file, "%f", f); + xfget_buf(pic, file, &buf, &len); + str = pic_str_value(pic, buf, len); + xfclose(pic, file); } return pic_obj_value(str); diff --git a/extlib/benz/port.c b/extlib/benz/port.c index 875ccf99..86373553 100644 --- a/extlib/benz/port.c +++ b/extlib/benz/port.c @@ -5,313 +5,25 @@ #include "picrin.h" #include "picrin/object.h" -static pic_value -pic_assert_port(pic_state *pic) -{ - struct pic_port *port; - - pic_get_args(pic, "p", &port); - - return pic_obj_value(port); -} - -/* current-(input|output|error)-port */ - -#if PIC_ENABLE_STDIO - -static int -file_read(pic_state PIC_UNUSED(*pic), void *cookie, char *ptr, int size) { - FILE *file = cookie; - int r; - - size = 1; /* override size */ - - r = (int)fread(ptr, 1, (size_t)size, file); - if (r < size && ferror(file)) { - return -1; - } - if (r == 0 && feof(file)) { - clearerr(file); - } - return r; -} - -static int -file_write(pic_state PIC_UNUSED(*pic), void *cookie, const char *ptr, int size) { - FILE *file = cookie; - int r; - - r = (int)fwrite(ptr, 1, (size_t)size, file); - if (r < size) { - return -1; - } - fflush(cookie); - return r; -} - -static long -file_seek(pic_state PIC_UNUSED(*pic), void *cookie, long pos, int whence) { - switch (whence) { - case XSEEK_CUR: - whence = SEEK_CUR; - break; - case XSEEK_SET: - whence = SEEK_SET; - break; - case XSEEK_END: - whence = SEEK_END; - break; - } - if (fseek(cookie, pos, whence) == 0) { - return ftell(cookie); - } - return -1; -} - -static int -file_close(pic_state PIC_UNUSED(*pic), void *cookie) { - return fclose(cookie); -} - -static xFILE * -file_open(pic_state *pic, const char *name, const char *mode) { - FILE *fp; - - if ((fp = fopen(name, mode)) == NULL) { - return NULL; - } - - switch (*mode) { - case 'r': - return xfunopen(pic, fp, file_read, NULL, file_seek, file_close); - default: - return xfunopen(pic, fp, NULL, file_write, file_seek, file_close); - } -} - -PIC_NORETURN static void -file_error(pic_state *pic, const char *msg) -{ - struct pic_error *e; - - e = pic_make_error(pic, "file", msg, pic_nil_value(pic)); - - pic_raise(pic, pic_obj_value(e)); -} - struct pic_port * -pic_open_file(pic_state *pic, const char *name, int flags) { - struct pic_port *port; - xFILE *file; - char mode = 'r'; - - if ((flags & PIC_PORT_IN) == 0) { - mode = 'w'; - } - if ((file = file_open(pic, name, &mode)) == NULL) { - file_error(pic, pic_str(pic, pic_strf_value(pic, "could not open file '%s'", name))); - } - - port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT); - port->file = file; - port->flags = flags | PIC_PORT_OPEN; - - return port; -} - -#else - -/* null file */ - -static int -null_read(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie), char PIC_UNUSED(*ptr), int PIC_UNUSED(size)) { - return 0; -} - -static int -null_write(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie), const char PIC_UNUSED(*ptr), int size) { - return size; -} - -static long -null_seek(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie), long PIC_UNUSED(pos), int PIC_UNUSED(whence)) { - return 0; -} - -static int -null_close(pic_state PIC_UNUSED(*pic), void PIC_UNUSED(*cookie)) { - return 0; -} - -#endif - -static void -pic_define_standard_port(pic_state *pic, const char *name, xFILE *file, int dir) +pic_make_port(pic_state *pic, xFILE *file) { struct pic_port *port; port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT); port->file = file; - port->flags = dir | PIC_PORT_OPEN; - - pic_defvar(pic, name, pic_obj_value(port), pic_make_proc(pic, pic_assert_port, 0, NULL)); -} - -#define DEFINE_STANDARD_PORT_ACCESSOR(name, var) \ - struct pic_port * \ - name(pic_state *pic) \ - { \ - pic_value obj; \ - \ - obj = pic_funcall(pic, "picrin.base", var, 0); \ - \ - return pic_port_ptr(obj); \ - } - -DEFINE_STANDARD_PORT_ACCESSOR(pic_stdin, "current-input-port") -DEFINE_STANDARD_PORT_ACCESSOR(pic_stdout, "current-output-port") -DEFINE_STANDARD_PORT_ACCESSOR(pic_stderr, "current-error-port") - -struct strfile { - char *buf; - long pos, end, capa; -}; - -static int -string_read(pic_state PIC_UNUSED(*pic), void *cookie, char *ptr, int size) -{ - struct strfile *m = cookie; - - if (size > (int)(m->end - m->pos)) - size = (int)(m->end - m->pos); - memcpy(ptr, m->buf + m->pos, size); - m->pos += size; - return size; -} - -static int -string_write(pic_state *pic, void *cookie, const char *ptr, int size) -{ - struct strfile *m = cookie; - - if (m->pos + size >= m->capa) { - m->capa = (m->pos + size) * 2; - m->buf = pic_realloc(pic, m->buf, m->capa); - } - memcpy(m->buf + m->pos, ptr, size); - m->pos += size; - if (m->end < m->pos) - m->end = m->pos; - return size; -} - -static long -string_seek(pic_state PIC_UNUSED(*pic), void *cookie, long pos, int whence) -{ - struct strfile *m = cookie; - - switch (whence) { - case XSEEK_SET: - m->pos = pos; - break; - case XSEEK_CUR: - m->pos += pos; - break; - case XSEEK_END: - m->pos = m->end + pos; - break; - } - - return m->pos; -} - -static int -string_close(pic_state *pic, void *cookie) -{ - struct strfile *m = cookie; - - pic_free(pic, m->buf); - pic_free(pic, m); - return 0; -} - -static xFILE * -string_open(pic_state *pic, const char *data, size_t size) -{ - struct strfile *m; - xFILE *file; - - m = pic_malloc(pic, sizeof(struct strfile)); - m->buf = pic_malloc(pic, size); - m->pos = 0; - m->end = size; - m->capa = size; - - - if (data != NULL) { - memcpy(m->buf, data, size); - file = xfunopen(pic, m, string_read, NULL, string_seek, string_close); - } else { - file = xfunopen(pic, m, NULL, string_write, string_seek, string_close); - } - - if (file == NULL) { - string_close(pic, m); - pic_error(pic, "", "could not open new output string/bytevector port", pic_nil_value(pic)); - } - return file; -} - -struct pic_port * -pic_open_input_string(pic_state *pic, const char *str) -{ - struct pic_port *port; - - port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT); - port->file = string_open(pic, str, strlen(str)); - port->flags = PIC_PORT_IN | PIC_PORT_OPEN; - return port; } -struct pic_port * -pic_open_output_string(pic_state *pic) -{ - struct pic_port *port; - - port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT); - port->file = string_open(pic, NULL, 0); - port->flags = PIC_PORT_OUT | PIC_PORT_OPEN; - - return port; -} - -struct pic_string * -pic_get_output_string(pic_state *pic, struct pic_port *port) -{ - struct strfile *s; - - if (port->file->vtable.write != string_write) { - pic_errorf(pic, "get-output-string: port is not made by open-output-string"); - } - - xfflush(pic, port->file); - - s = port->file->vtable.cookie; - - return pic_str_value(pic, s->buf, s->end); -} - void pic_close_port(pic_state *pic, struct pic_port *port) { - if ((port->flags & PIC_PORT_OPEN) == 0) { + if (port->file->flag == 0) { return; } if (xfclose(pic, port->file) == EOF) { pic_errorf(pic, "close-port: failure"); } - port->flags &= ~PIC_PORT_OPEN; } static pic_value @@ -321,10 +33,9 @@ pic_port_input_port_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_port_p(pic, v) && (pic_port_ptr(v)->flags & PIC_PORT_IN) != 0) { + if (pic_port_p(pic, v) && (pic_port_ptr(v)->file->flag & X_READ) != 0) { return pic_true_value(pic); - } - else { + } else { return pic_false_value(pic); } } @@ -336,7 +47,7 @@ pic_port_output_port_p(pic_state *pic) pic_get_args(pic, "o", &v); - if (pic_port_p(pic, v) && (pic_port_ptr(v)->flags & PIC_PORT_OUT) != 0) { + if (pic_port_p(pic, v) && (pic_port_ptr(v)->file->flag & X_WRITE) != 0) { return pic_true_value(pic); } else { @@ -379,7 +90,7 @@ pic_port_port_open_p(pic_state *pic) pic_get_args(pic, "p", &port); - return pic_bool_value(pic, port->flags & PIC_PORT_OPEN); + return pic_bool_value(pic, port->file->flag != 0); } static pic_value @@ -394,80 +105,65 @@ pic_port_close_port(pic_state *pic) return pic_undef_value(pic); } -#define assert_port_profile(port, flgs, caller) do { \ - if ((port->flags & (flgs)) != (flgs)) { \ - switch (flgs) { \ - case PIC_PORT_IN: \ +#define assert_port_profile(port, flags, caller) do { \ + if ((port->file->flag & (flags)) != (flags)) { \ + switch (flags) { \ + case X_WRITE: \ pic_errorf(pic, caller ": expected output port"); \ - case PIC_PORT_OUT: \ + case X_READ: \ pic_errorf(pic, caller ": expected input port"); \ } \ } \ - if ((port->flags & PIC_PORT_OPEN) == 0) { \ + if (port->file->flag == 0) { \ pic_errorf(pic, caller ": expected open port"); \ } \ } while (0) static pic_value -pic_port_open_input_blob(pic_state *pic) +pic_port_open_input_bytevector(pic_state *pic) { - struct pic_port *port; struct pic_blob *blob; + xFILE *file; pic_get_args(pic, "b", &blob); - port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT); - port->file = string_open(pic, (const char *)blob->data, blob->len); - port->flags = PIC_PORT_IN | PIC_PORT_OPEN; + file = xfopen_buf(pic, (const char *)blob->data, blob->len, "r"); - return pic_obj_value(port); + return pic_obj_value(pic_make_port(pic, file)); } static pic_value pic_port_open_output_bytevector(pic_state *pic) { - struct pic_port *port; - pic_get_args(pic, ""); - port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT); - port->file = string_open(pic, NULL, 0); - port->flags = PIC_PORT_OUT | PIC_PORT_OPEN; - - return pic_obj_value(port); + return pic_obj_value(pic_make_port(pic, xfopen_buf(pic, NULL, 0, "w"))); } static pic_value pic_port_get_output_bytevector(pic_state *pic) { struct pic_port *port = pic_stdout(pic); - struct pic_blob *blob; - struct strfile *s; + const char *buf; + int len; pic_get_args(pic, "|p", &port); - assert_port_profile(port, PIC_PORT_OUT, "get-output-bytevector"); + assert_port_profile(port, X_WRITE, "get-output-bytevector"); - if (port->file->vtable.write != string_write) { - pic_errorf(pic, "get-output-bytevector: port is not made by open-output-bytevector"); + if (xfget_buf(pic, port->file, &buf, &len) < 0) { + pic_errorf(pic, "port was not created by open-output-bytevector"); } - - xfflush(pic, port->file); - - s = port->file->vtable.cookie; - - blob = pic_blob_value(pic, (unsigned char *)s->buf, s->end); - - return pic_obj_value(blob); + return pic_obj_value(pic_blob_value(pic, (unsigned char *)buf, len)); } static pic_value -pic_port_read_byte(pic_state *pic){ +pic_port_read_u8(pic_state *pic){ struct pic_port *port = pic_stdin(pic); int c; pic_get_args(pic, "|p", &port); - assert_port_profile(port, PIC_PORT_IN, "read-u8"); + assert_port_profile(port, X_READ, "read-u8"); if ((c = xfgetc(pic, port->file)) == EOF) { return pic_eof_object(pic); } @@ -476,14 +172,14 @@ pic_port_read_byte(pic_state *pic){ } static pic_value -pic_port_peek_byte(pic_state *pic) +pic_port_peek_u8(pic_state *pic) { int c; struct pic_port *port = pic_stdin(pic); pic_get_args(pic, "|p", &port); - assert_port_profile(port, PIC_PORT_IN, "peek-u8"); + assert_port_profile(port, X_READ, "peek-u8"); c = xfgetc(pic, port->file); if (c == EOF) { @@ -496,15 +192,15 @@ pic_port_peek_byte(pic_state *pic) } static pic_value -pic_port_byte_ready_p(pic_state *pic) +pic_port_u8_ready_p(pic_state *pic) { struct pic_port *port = pic_stdin(pic); pic_get_args(pic, "|p", &port); - assert_port_profile(port, PIC_PORT_IN, "u8-ready?"); + assert_port_profile(port, X_READ, "u8-ready?"); - return pic_true_value(pic); /* FIXME: always returns #t */ + return pic_true_value(pic); /* FIXME: always returns #t */ } @@ -517,7 +213,7 @@ pic_port_read_bytevector(pic_state *pic) pic_get_args(pic, "i|p", &k, &port); - assert_port_profile(port, PIC_PORT_IN, "read-bytevector"); + assert_port_profile(port, X_READ, "read-bytevector"); blob = pic_blob_value(pic, 0, k); @@ -550,7 +246,7 @@ pic_port_read_bytevector_ip(pic_state *pic) end = bv->len; } - assert_port_profile(port, PIC_PORT_IN, "read-bytevector!"); + assert_port_profile(port, X_READ, "read-bytevector!"); if (end < start) { pic_errorf(pic, "read-bytevector!: end index must be greater than or equal to start index"); @@ -572,14 +268,14 @@ pic_port_read_bytevector_ip(pic_state *pic) } static pic_value -pic_port_write_byte(pic_state *pic) +pic_port_write_u8(pic_state *pic) { int i; struct pic_port *port = pic_stdout(pic); pic_get_args(pic, "i|p", &i, &port); - assert_port_profile(port, PIC_PORT_OUT, "write-u8"); + assert_port_profile(port, X_WRITE, "write-u8"); xfputc(pic, i, port->file); return pic_undef_value(pic); @@ -602,7 +298,7 @@ pic_port_write_bytevector(pic_state *pic) end = blob->len; } - assert_port_profile(port, PIC_PORT_OUT, "write-bytevector"); + assert_port_profile(port, X_WRITE, "write-bytevector"); for (i = start; i < end; ++i) { xfputc(pic, blob->data[i], port->file); @@ -617,40 +313,33 @@ pic_port_flush(pic_state *pic) pic_get_args(pic, "|p", &port); - assert_port_profile(port, PIC_PORT_OUT, "flush-output-port"); + assert_port_profile(port, X_WRITE, "flush-output-port"); xfflush(pic, port->file); return pic_undef_value(pic); } +static pic_value +coerce_port(pic_state *pic) +{ + struct pic_port *port; + + pic_get_args(pic, "p", &port); + + return pic_obj_value(port); +} + +#define DEFINE_PORT(pic, name, file) \ + pic_defvar(pic, name, pic_obj_value(pic_make_port(pic, file)), coerce) + void pic_init_port(pic_state *pic) { -#if PIC_ENABLE_STDIO -# define FILE_VTABLE { 0, file_read, file_write, file_seek, file_close } -#else -# define FILE_VTABLE { 0, null_read, null_write, null_seek, null_close } -#endif + struct pic_proc *coerce = pic_lambda(pic, coerce_port, 0); - static const xFILE skel[3] = { - { { 0 }, 0, NULL, NULL, FILE_VTABLE, X_READ }, - { { 0 }, 0, NULL, NULL, FILE_VTABLE, X_WRITE | X_LNBUF }, - { { 0 }, 0, NULL, NULL, FILE_VTABLE, X_WRITE | X_UNBUF } - }; - - pic->files[0] = skel[0]; - pic->files[1] = skel[1]; - pic->files[2] = skel[2]; - -#if PIC_ENABLE_STDIO - pic->files[0].vtable.cookie = stdin; - pic->files[1].vtable.cookie = stdout; - pic->files[2].vtable.cookie = stderr; -#endif - - pic_define_standard_port(pic, "current-input-port", xstdin, PIC_PORT_IN); - pic_define_standard_port(pic, "current-output-port", xstdout, PIC_PORT_OUT); - pic_define_standard_port(pic, "current-error-port", xstderr, PIC_PORT_OUT); + DEFINE_PORT(pic, "current-input-port", xstdin); + DEFINE_PORT(pic, "current-output-port", xstdout); + DEFINE_PORT(pic, "current-error-port", xstderr); pic_defun(pic, "port?", pic_port_port_p); pic_defun(pic, "input-port?", pic_port_input_port_p); @@ -661,20 +350,20 @@ pic_init_port(pic_state *pic) pic_defun(pic, "eof-object?", pic_port_eof_object_p); pic_defun(pic, "eof-object", pic_port_eof_object); - /* string I/O */ - pic_defun(pic, "open-input-bytevector", pic_port_open_input_blob); - pic_defun(pic, "open-output-bytevector", pic_port_open_output_bytevector); - pic_defun(pic, "get-output-bytevector", pic_port_get_output_bytevector); - /* input */ - pic_defun(pic, "read-u8", pic_port_read_byte); - pic_defun(pic, "peek-u8", pic_port_peek_byte); - pic_defun(pic, "u8-ready?", pic_port_byte_ready_p); + pic_defun(pic, "read-u8", pic_port_read_u8); + pic_defun(pic, "peek-u8", pic_port_peek_u8); + pic_defun(pic, "u8-ready?", pic_port_u8_ready_p); pic_defun(pic, "read-bytevector", pic_port_read_bytevector); pic_defun(pic, "read-bytevector!", pic_port_read_bytevector_ip); /* output */ - pic_defun(pic, "write-u8", pic_port_write_byte); + pic_defun(pic, "write-u8", pic_port_write_u8); pic_defun(pic, "write-bytevector", pic_port_write_bytevector); pic_defun(pic, "flush-output-port", pic_port_flush); + + /* string I/O */ + pic_defun(pic, "open-input-bytevector", pic_port_open_input_bytevector); + pic_defun(pic, "open-output-bytevector", pic_port_open_output_bytevector); + pic_defun(pic, "get-output-bytevector", pic_port_get_output_bytevector); } diff --git a/extlib/benz/read.c b/extlib/benz/read.c index f096564b..fbad22f7 100644 --- a/extlib/benz/read.c +++ b/extlib/benz/read.c @@ -842,7 +842,7 @@ pic_read(pic_state *pic, struct pic_port *port) pic_value pic_read_cstr(pic_state *pic, const char *str) { - struct pic_port *port = pic_open_input_string(pic, str); + struct pic_port *port = pic_make_port(pic, xfopen_buf(pic, str, strlen(str), "r")); pic_value form; pic_try { diff --git a/extlib/benz/state.c b/extlib/benz/state.c index a6e0ee97..1cd7c969 100644 --- a/extlib/benz/state.c +++ b/extlib/benz/state.c @@ -188,7 +188,6 @@ pic_init_core(pic_state *pic) pic_state * pic_open(pic_allocf allocf, void *userdata) { - struct pic_port *pic_make_standard_port(pic_state *, xFILE *, short); char t; pic_state *pic; @@ -280,6 +279,17 @@ pic_open(pic_allocf allocf, void *userdata) /* file pool */ memset(pic->files, 0, sizeof pic->files); +#if PIC_ENABLE_STDIO + xfopen_file(pic, stdin, "r"); + xfopen_file(pic, stdout, "w"); + xfopen_file(pic, stderr, "w"); + pic->files[1].flag |= X_LNBUF; + pic->files[2].flag |= X_UNBUF; +#else + xfopen_null(pic, "r"); + xfopen_null(pic, "w"); + xfopen_null(pic, "w"); +#endif /* parameter table */ pic->ptable = pic_nil_value(pic); diff --git a/extlib/benz/string.c b/extlib/benz/string.c index 0472fae3..d449953b 100644 --- a/extlib/benz/string.c +++ b/extlib/benz/string.c @@ -309,7 +309,7 @@ pic_str(pic_state *pic, struct pic_string *str) } static void -pic_vfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap) +vfstrf(pic_state *pic, xFILE *file, const char *fmt, va_list ap) { char c; @@ -377,15 +377,17 @@ pic_vfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap) struct pic_string * pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap) { - struct pic_port *port; struct pic_string *str; + xFILE *file; + const char *buf; + int len; - port = pic_open_output_string(pic); + file = xfopen_buf(pic, NULL, 0, "w"); - pic_vfformat(pic, port->file, fmt, ap); - str = pic_get_output_string(pic, port); - - pic_close_port(pic, port); + vfstrf(pic, file, fmt, ap); + xfget_buf(pic, file, &buf, &len); + str = pic_str_value(pic, buf, len); + xfclose(pic, file); return str; }