Merge branch 'fix-port'

This commit is contained in:
Yuichi Nishiwaki 2015-06-19 00:46:30 +09:00
commit 9263891c4c
8 changed files with 71 additions and 104 deletions

View File

@ -27,8 +27,7 @@ generic_open_file(pic_state *pic, const char *fname, char *mode, short flags)
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
port->file = file; port->file = file;
port->flags = flags; port->flags = flags | PIC_PORT_OPEN;
port->status = PIC_PORT_OPEN;
return pic_obj_value(port); return pic_obj_value(port);
} }

View File

@ -17,8 +17,7 @@ pic_load(pic_state *pic, const char *filename)
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
port->file = file; port->file = file;
port->flags = PIC_PORT_IN | PIC_PORT_TEXT; port->flags = PIC_PORT_IN | PIC_PORT_TEXT | PIC_PORT_OPEN;
port->status = PIC_PORT_OPEN;
pic_load_port(pic, port); pic_load_port(pic, port);

View File

@ -617,17 +617,6 @@ gc_mark_phase(pic_state *pic)
/* library table */ /* library table */
gc_mark(pic, pic->libs); gc_mark(pic, pic->libs);
/* standard I/O ports */
if (pic->xSTDIN) {
gc_mark_object(pic, (struct pic_object *)pic->xSTDIN);
}
if (pic->xSTDOUT) {
gc_mark_object(pic, (struct pic_object *)pic->xSTDOUT);
}
if (pic->xSTDERR) {
gc_mark_object(pic, (struct pic_object *)pic->xSTDERR);
}
/* parameter table */ /* parameter table */
gc_mark(pic, pic->ptable); gc_mark(pic, pic->ptable);

View File

@ -143,12 +143,9 @@ typedef struct {
size_t arena_size, arena_idx; size_t arena_size, arena_idx;
struct pic_reg *regs; struct pic_reg *regs;
struct pic_port *xSTDIN, *xSTDOUT, *xSTDERR;
pic_value err; pic_value err;
pic_code *iseq; /* for pic_apply_trampoline */ pic_code *iseq; /* for pic_apply_trampoline */
char *native_stack_start; char *native_stack_start;
} pic_state; } pic_state;
@ -204,6 +201,10 @@ void pic_load_port(pic_state *, struct pic_port *);
void pic_load_cstr(pic_state *, const char *); void pic_load_cstr(pic_state *, const char *);
pic_value pic_funcall(pic_state *pic, struct pic_lib *, const char *, pic_list); pic_value pic_funcall(pic_state *pic, struct pic_lib *, const char *, pic_list);
pic_value pic_funcall0(pic_state *pic, struct pic_lib *, const char *);
pic_value pic_funcall1(pic_state *pic, struct pic_lib *, const char *, pic_value);
pic_value pic_funcall2(pic_state *pic, struct pic_lib *, const char *, pic_value, pic_value);
pic_value pic_funcall3(pic_state *pic, struct pic_lib *, const char *, pic_value, pic_value, pic_value);
pic_value pic_ref(pic_state *, struct pic_lib *, const char *); pic_value pic_ref(pic_state *, struct pic_lib *, const char *);
void pic_set(pic_state *, struct pic_lib *, const char *, pic_value); void pic_set(pic_state *, struct pic_lib *, const char *, pic_value);
@ -257,7 +258,7 @@ pic_value pic_display(pic_state *, pic_value);
pic_value pic_fdisplay(pic_state *, pic_value, xFILE *); pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
#if DEBUG #if DEBUG
# define pic_debug(pic,obj) pic_fwrite(pic,obj,pic->xSTDERR->file) # define pic_debug(pic,obj) pic_fwrite(pic,obj,xstderr)
# define pic_fdebug(pic,obj,file) pic_fwrite(pic,obj,file) # define pic_fdebug(pic,obj,file) pic_fwrite(pic,obj,file)
#endif #endif

View File

@ -13,19 +13,14 @@ enum pic_port_flag {
PIC_PORT_IN = 1, PIC_PORT_IN = 1,
PIC_PORT_OUT = 2, PIC_PORT_OUT = 2,
PIC_PORT_TEXT = 4, PIC_PORT_TEXT = 4,
PIC_PORT_BINARY = 8 PIC_PORT_BINARY = 8,
}; PIC_PORT_OPEN = 16
enum pic_port_status {
PIC_PORT_OPEN,
PIC_PORT_CLOSE
}; };
struct pic_port { struct pic_port {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
xFILE *file; xFILE *file;
int flags; int flags;
int status;
}; };
#define pic_port_p(v) (pic_type(v) == PIC_TT_PORT) #define pic_port_p(v) (pic_type(v) == PIC_TT_PORT)

View File

@ -14,48 +14,45 @@ pic_eof_object()
return v; return v;
} }
struct pic_port * static pic_value
pic_stdin(pic_state *pic) pic_assert_port(pic_state *pic)
{ {
pic_value obj; struct pic_port *port;
obj = pic_funcall(pic, pic->PICRIN_BASE, "current-input-port", pic_nil_value()); pic_get_args(pic, "p", &port);
return pic_port_ptr(obj); return pic_obj_value(port);
} }
struct pic_port * /* current-(input|output|error)-port */
pic_stdout(pic_state *pic)
{
pic_value obj;
obj = pic_funcall(pic, pic->PICRIN_BASE, "current-output-port", pic_nil_value()); static void
pic_define_standard_port(pic_state *pic, const char *name, xFILE *file, int dir)
return pic_port_ptr(obj);
}
struct pic_port *
pic_stderr(pic_state *pic)
{
pic_value obj;
obj = pic_funcall(pic, pic->PICRIN_BASE, "current-error-port", pic_nil_value());
return pic_port_ptr(obj);
}
struct pic_port *
pic_make_standard_port(pic_state *pic, xFILE *file, short dir)
{ {
struct pic_port *port; struct pic_port *port;
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
port->file = file; port->file = file;
port->flags = dir | PIC_PORT_TEXT; port->flags = dir | PIC_PORT_TEXT | PIC_PORT_OPEN;
port->status = PIC_PORT_OPEN;
return port; pic_defvar(pic, name, pic_obj_value(port), pic_make_proc(pic, pic_assert_port, "pic_assert_port"));
} }
#define DEFINE_STANDARD_PORT_ACCESSOR(name, var) \
struct pic_port * \
name(pic_state *pic) \
{ \
pic_value obj; \
\
obj = pic_funcall0(pic, pic->PICRIN_BASE, var); \
\
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 { struct strfile {
pic_state *pic; pic_state *pic;
char *buf; char *buf;
@ -155,8 +152,7 @@ pic_open_input_string(pic_state *pic, const char *str)
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT);
port->file = string_open(pic, str, strlen(str)); port->file = string_open(pic, str, strlen(str));
port->flags = PIC_PORT_IN | PIC_PORT_TEXT; port->flags = PIC_PORT_IN | PIC_PORT_TEXT | PIC_PORT_OPEN;
port->status = PIC_PORT_OPEN;
return port; return port;
} }
@ -168,8 +164,7 @@ pic_open_output_string(pic_state *pic)
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT);
port->file = string_open(pic, NULL, 0); port->file = string_open(pic, NULL, 0);
port->flags = PIC_PORT_OUT | PIC_PORT_TEXT; port->flags = PIC_PORT_OUT | PIC_PORT_TEXT | PIC_PORT_OPEN;
port->status = PIC_PORT_OPEN;
return port; return port;
} }
@ -196,7 +191,7 @@ pic_close_port(pic_state *pic, struct pic_port *port)
if (xfclose(port->file) == EOF) { if (xfclose(port->file) == EOF) {
pic_errorf(pic, "close-port: failure"); pic_errorf(pic, "close-port: failure");
} }
port->status = PIC_PORT_CLOSE; port->flags &= ~PIC_PORT_OPEN;
} }
static pic_value static pic_value
@ -315,7 +310,7 @@ pic_port_port_open_p(pic_state *pic)
pic_get_args(pic, "p", &port); pic_get_args(pic, "p", &port);
return pic_bool_value(port->status == PIC_PORT_OPEN); return pic_bool_value(port->flags & PIC_PORT_OPEN);
} }
static pic_value static pic_value
@ -330,7 +325,7 @@ pic_port_close_port(pic_state *pic)
return pic_undef_value(); return pic_undef_value();
} }
#define assert_port_profile(port, flgs, stat, caller) do { \ #define assert_port_profile(port, flgs, caller) do { \
if ((port->flags & (flgs)) != (flgs)) { \ if ((port->flags & (flgs)) != (flgs)) { \
switch (flgs) { \ switch (flgs) { \
case PIC_PORT_IN: \ case PIC_PORT_IN: \
@ -347,13 +342,8 @@ pic_port_close_port(pic_state *pic)
pic_errorf(pic, caller ": expected output/binary port"); \ pic_errorf(pic, caller ": expected output/binary port"); \
} \ } \
} \ } \
if (port->status != stat) { \ if ((port->flags & PIC_PORT_OPEN) == 0) { \
switch (stat) { \ pic_errorf(pic, caller ": expected open port"); \
case PIC_PORT_OPEN: \
pic_errorf(pic, caller ": expected open port"); \
case PIC_PORT_CLOSE: \
pic_errorf(pic, caller ": expected close port"); \
} \
} \ } \
} while (0) } while (0)
@ -389,7 +379,7 @@ pic_port_get_output_string(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "get-output-string"); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "get-output-string");
return pic_obj_value(pic_get_output_string(pic, port)); return pic_obj_value(pic_get_output_string(pic, port));
} }
@ -404,8 +394,7 @@ pic_port_open_input_blob(pic_state *pic)
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT);
port->file = string_open(pic, (const char *)blob->data, blob->len); port->file = string_open(pic, (const char *)blob->data, blob->len);
port->flags = PIC_PORT_IN | PIC_PORT_BINARY; port->flags = PIC_PORT_IN | PIC_PORT_BINARY | PIC_PORT_OPEN;
port->status = PIC_PORT_OPEN;
return pic_obj_value(port); return pic_obj_value(port);
} }
@ -419,8 +408,7 @@ pic_port_open_output_bytevector(pic_state *pic)
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port *), PIC_TT_PORT);
port->file = string_open(pic, NULL, 0); port->file = string_open(pic, NULL, 0);
port->flags = PIC_PORT_OUT | PIC_PORT_BINARY; port->flags = PIC_PORT_OUT | PIC_PORT_BINARY | PIC_PORT_OPEN;
port->status = PIC_PORT_OPEN;
return pic_obj_value(port); return pic_obj_value(port);
} }
@ -434,7 +422,7 @@ pic_port_get_output_bytevector(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "get-output-bytevector"); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "get-output-bytevector");
if (port->file->vtable.write != string_write) { if (port->file->vtable.write != string_write) {
pic_errorf(pic, "get-output-bytevector: port is not made by open-output-bytevector"); pic_errorf(pic, "get-output-bytevector: port is not made by open-output-bytevector");
@ -458,7 +446,7 @@ pic_port_read_char(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "read-char"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-char");
if ((c = xfgetc(port->file)) == EOF) { if ((c = xfgetc(port->file)) == EOF) {
return pic_eof_object(); return pic_eof_object();
@ -476,7 +464,7 @@ pic_port_peek_char(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "peek-char"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "peek-char");
if ((c = xfgetc(port->file)) == EOF) { if ((c = xfgetc(port->file)) == EOF) {
return pic_eof_object(); return pic_eof_object();
@ -496,7 +484,7 @@ pic_port_read_line(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "read-line"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-line");
buf = pic_open_output_string(pic); buf = pic_open_output_string(pic);
while ((c = xfgetc(port->file)) != EOF && c != '\n') { while ((c = xfgetc(port->file)) != EOF && c != '\n') {
@ -517,7 +505,7 @@ pic_port_char_ready_p(pic_state *pic)
{ {
struct pic_port *port = pic_stdin(pic); struct pic_port *port = pic_stdin(pic);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "char-ready?"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "char-ready?");
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
@ -533,7 +521,7 @@ pic_port_read_string(pic_state *pic){
pic_get_args(pic, "i|p", &k, &port); pic_get_args(pic, "i|p", &k, &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "read-stritg"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-stritg");
c = EOF; c = EOF;
buf = pic_open_output_string(pic); buf = pic_open_output_string(pic);
@ -560,7 +548,7 @@ pic_port_read_byte(pic_state *pic){
int c; int c;
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-u8"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-u8");
if ((c = xfgetc(port->file)) == EOF) { if ((c = xfgetc(port->file)) == EOF) {
return pic_eof_object(); return pic_eof_object();
} }
@ -576,7 +564,7 @@ pic_port_peek_byte(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "peek-u8"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "peek-u8");
c = xfgetc(port->file); c = xfgetc(port->file);
if (c == EOF) { if (c == EOF) {
@ -595,7 +583,7 @@ pic_port_byte_ready_p(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "u8-ready?"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "u8-ready?");
return pic_true_value(); /* FIXME: always returns #t */ return pic_true_value(); /* FIXME: always returns #t */
} }
@ -610,7 +598,7 @@ pic_port_read_blob(pic_state *pic)
pic_get_args(pic, "k|p", &k, &port); pic_get_args(pic, "k|p", &k, &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-bytevector");
blob = pic_make_blob(pic, k); blob = pic_make_blob(pic, k);
@ -644,7 +632,7 @@ pic_port_read_blob_ip(pic_state *pic)
end = bv->len; end = bv->len;
} }
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector!"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-bytevector!");
if (end < start) { if (end < start) {
pic_errorf(pic, "read-bytevector!: end index must be greater than or equal to start index"); pic_errorf(pic, "read-bytevector!: end index must be greater than or equal to start index");
@ -672,7 +660,7 @@ pic_port_newline(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "newline"); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "newline");
xfputs("\n", port->file); xfputs("\n", port->file);
return pic_undef_value(); return pic_undef_value();
@ -686,7 +674,7 @@ pic_port_write_char(pic_state *pic)
pic_get_args(pic, "c|p", &c, &port); pic_get_args(pic, "c|p", &c, &port);
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "write-char"); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "write-char");
xfputc(c, port->file); xfputc(c, port->file);
return pic_undef_value(); return pic_undef_value();
@ -709,7 +697,7 @@ pic_port_write_string(pic_state *pic)
end = INT_MAX; end = INT_MAX;
} }
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "write-string"); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "write-string");
for (i = start; i < end && str[i] != '\0'; ++i) { for (i = start; i < end && str[i] != '\0'; ++i) {
xfputc(str[i], port->file); xfputc(str[i], port->file);
@ -725,7 +713,7 @@ pic_port_write_byte(pic_state *pic)
pic_get_args(pic, "i|p", &i, &port); pic_get_args(pic, "i|p", &i, &port);
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "write-u8"); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "write-u8");
xfputc(i, port->file); xfputc(i, port->file);
return pic_undef_value(); return pic_undef_value();
@ -749,7 +737,7 @@ pic_port_write_blob(pic_state *pic)
end = blob->len; end = blob->len;
} }
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "write-bytevector"); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "write-bytevector");
for (i = start; i < end; ++i) { for (i = start; i < end; ++i) {
xfputc(blob->data[i], port->file); xfputc(blob->data[i], port->file);
@ -764,7 +752,7 @@ pic_port_flush(pic_state *pic)
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_OUT, PIC_PORT_OPEN, "flush-output-port"); assert_port_profile(port, PIC_PORT_OUT, "flush-output-port");
xfflush(port->file); xfflush(port->file);
return pic_undef_value(); return pic_undef_value();
@ -773,9 +761,9 @@ pic_port_flush(pic_state *pic)
void void
pic_init_port(pic_state *pic) pic_init_port(pic_state *pic)
{ {
pic_defvar(pic, "current-input-port", pic_obj_value(pic->xSTDIN), NULL); pic_define_standard_port(pic, "current-input-port", xstdin, PIC_PORT_IN);
pic_defvar(pic, "current-output-port", pic_obj_value(pic->xSTDOUT), NULL); pic_define_standard_port(pic, "current-output-port", xstdout, PIC_PORT_OUT);
pic_defvar(pic, "current-error-port", pic_obj_value(pic->xSTDERR), NULL); pic_define_standard_port(pic, "current-error-port", xstderr, PIC_PORT_OUT);
pic_defun(pic, "call-with-port", pic_port_call_with_port); pic_defun(pic, "call-with-port", pic_port_call_with_port);

View File

@ -254,11 +254,6 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
/* raised error object */ /* raised error object */
pic->err = pic_invalid_value(); pic->err = pic_invalid_value();
/* standard ports */
pic->xSTDIN = NULL;
pic->xSTDOUT = NULL;
pic->xSTDERR = NULL;
/* parameter table */ /* parameter table */
pic->ptable = pic_nil_value(); pic->ptable = pic_nil_value();
@ -372,11 +367,6 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
/* reader */ /* reader */
pic->reader = pic_reader_open(pic); pic->reader = pic_reader_open(pic);
/* standard I/O */
pic->xSTDIN = pic_make_standard_port(pic, xstdin, PIC_PORT_IN);
pic->xSTDOUT = pic_make_standard_port(pic, xstdout, PIC_PORT_OUT);
pic->xSTDERR = pic_make_standard_port(pic, xstderr, PIC_PORT_OUT);
/* parameter table */ /* parameter table */
pic->ptable = pic_cons(pic, pic_obj_value(pic_make_dict(pic)), pic->ptable); pic->ptable = pic_cons(pic, pic_obj_value(pic_make_dict(pic)), pic->ptable);

View File

@ -467,6 +467,12 @@ pic_funcall(pic_state *pic, struct pic_lib *lib, const char *name, pic_list args
return pic_apply(pic, pic_proc_ptr(proc), args); return pic_apply(pic, pic_proc_ptr(proc), args);
} }
pic_value
pic_funcall0(pic_state *pic, struct pic_lib *lib, const char *name)
{
return pic_funcall(pic, lib, name, pic_nil_value());
}
void void
pic_defun(pic_state *pic, const char *name, pic_func_t cfunc) pic_defun(pic_state *pic, const char *name, pic_func_t cfunc)
{ {