/** * See Copyright Notice in picrin.h */ #include #include #include #include #include "picrin.h" #include "picrin/proc.h" #include "picrin/port.h" pic_value pic_eof_object() { pic_value v; pic_init_value(v, PIC_VTYPE_EOF); return v; } struct pic_port * pic_stdin(pic_state *pic) { struct pic_proc *proc; proc = pic_proc_ptr(pic_ref(pic, "current-input-port")); return pic_port_ptr(pic_apply(pic, proc, pic_nil_value())); } struct pic_port * pic_stdout(pic_state *pic) { struct pic_proc *proc; proc = pic_proc_ptr(pic_ref(pic, "current-output-port")); return pic_port_ptr(pic_apply(pic, proc, pic_nil_value())); } int pic_setvbuf(pic_file *file, char *buf, int mode, size_t bufsiz) { /* FIXME: free old buf */ assert(mode != _IONBF); /* FIXME: support IONBF */ file->mode = mode; if (buf) { file->buf = buf; file->bufsiz = bufsiz; } else { if (mode == _IONBF) { file->buf = NULL; file->bufsiz = 0; } else { assert(bufsiz == 0); file->buf = (char *)malloc(BUFSIZ); file->bufsiz = BUFSIZ; } } file->s = file->c = file->buf; file->e = file->buf + file->bufsiz; return 0; } int pic_fflush(pic_file *file) { int r; r = file->vtable.write(file->vtable.cookie, file->s, file->c - file->s); /* TODO: error handling (r == -1 or r < file->c - file->s)*/ file->c -= r; return r; } int pic_ffill(pic_file *file) { int r; r = file->vtable.read(file->vtable.cookie, file->c, file->e - file->c); /* TODO: error handling (r == -1) */ if (r < file->e - file->c) { file->flags |= PIC_FILE_EOF; } file->c += r; return r; } pic_file * pic_funopen(void *cookie, int (*read)(void *, char *, int), int (*write)(void *, const char *, int), long (*seek)(void *, long, int), int (*close)(void *)) { pic_file *file; file = (pic_file *)malloc(sizeof(pic_file)); if (! file) { return NULL; } file->flags = 0; /* no buffering at the beginning */ file->buf = NULL; file->mode = _IONBF; file->bufsiz = 0; file->us = PIC_UBUFSIZ; file->ur = 0; /* set vtable */ file->vtable.cookie = cookie; file->vtable.read = read; file->vtable.write = write; file->vtable.seek = seek; file->vtable.close = close; pic_setvbuf(file, (char *)NULL, _IOFBF, 0); return file; } static int file_read(void *cookie, char *ptr, int size) { return fread(ptr, 1, size, (FILE *)cookie); } static int file_write(void *cookie, const char *ptr, int size) { return fwrite(ptr, 1, size, (FILE *)cookie); } static long file_seek(void *cookie, long pos, int whence) { return fseek((FILE *)cookie, pos, whence); } static int file_close(void *cookie) { return fclose((FILE *)cookie); } pic_file * pic_fopen(const char *filename, const char *mode) { FILE *fp; fp = fopen(filename, mode); if (! fp) { return NULL; } return pic_funopen(fp, file_read, file_write, file_seek, file_close); } int pic_fclose(pic_file *file) { int r; r = file->vtable.close(file->vtable.cookie); if (! r) { return -1; } free(file); return 0; } size_t pic_fread(void *ptr, size_t block, size_t nitems, pic_file *file) { int size, avail; char *dst = (char *)ptr; size = block * nitems; /* TODO: optimize block read */ /* take care of ungetc buf */ while (file->ur > 0) { *dst++ = file->ub[--file->ur]; if (--size == 0) return block * nitems; } while (1) { avail = file->c - file->s; if (size <= avail) { memcpy(dst, file->s, size); memmove(file->s, file->s + size, avail - size); file->c -= size; return block * nitems; } else { memcpy(dst, file->s, avail); file->c = file->s; size -= avail; dst += avail; if ((file->flags & PIC_FILE_EOF) != 0) break; pic_ffill(file); } } /* handle end-of-file */ *dst = EOF; return block * nitems - size; } size_t pic_fwrite(const void *ptr, size_t block, size_t nitems, pic_file *file) { int size, room; char *dst = (char *)ptr; size = block * nitems; /* TODO: optimize block write */ while (1) { room = file->e - file->c; if (room < size) { memcpy(file->c, dst, room); file->c = file->e; size -= room; dst += room; pic_fflush(file); } else { memcpy(file->c, dst, size); file->c += size; return block * nitems; } } } int pic_fgetc(pic_file *file) { char buf[1]; pic_fread(buf, 1, 1, file); return buf[0]; } int pic_ungetc(int c, pic_file *file) { return file->ub[file->ur++] = (char)c; } int pic_fputc(int c, pic_file *file) { char buf[1]; buf[0] = c; pic_fwrite(buf, 1, 1, file); return buf[0]; } int pic_fputs(const char *str, pic_file *file) { int len; len = strlen(str); pic_fwrite(str, len, 1, file); return 0; } static pic_value port_new_from_fp(pic_state *pic, FILE *fp, short flags) { struct pic_port *port; port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port->file = pic_funopen(fp, file_read, file_write, file_seek, file_close); port->flags = flags; port->status = PIC_PORT_OPEN; return pic_obj_value(port); } static pic_value port_new_stdio(pic_state *pic, FILE *fp, short dir) { return port_new_from_fp(pic, fp, dir | PIC_PORT_TEXT); } static pic_value pic_port_input_port_p(pic_state *pic) { pic_value v; pic_get_args(pic, "o", &v); if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_IN) != 0) { return pic_true_value(); } else { return pic_false_value(); } } static pic_value pic_port_output_port_p(pic_state *pic) { pic_value v; pic_get_args(pic, "o", &v); if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_OUT) != 0) { return pic_true_value(); } else { return pic_false_value(); } } static pic_value pic_port_textual_port_p(pic_state *pic) { pic_value v; pic_get_args(pic, "o", &v); if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_TEXT) != 0) { return pic_true_value(); } else { return pic_false_value(); } } static pic_value pic_port_binary_port_p(pic_state *pic) { pic_value v; pic_get_args(pic, "o", &v); if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_BINARY) != 0) { return pic_true_value(); } else { return pic_false_value(); } } static pic_value pic_port_port_p(pic_state *pic) { pic_value v; pic_get_args(pic, "o", &v); return pic_bool_value(pic_port_p(v)); } static pic_value pic_port_input_port_open_p(pic_state *pic) { pic_value v; struct pic_port *port; pic_get_args(pic, "o", &v); if (! pic_port_p(v)) return pic_false_value(); port = pic_port_ptr(v); if ((port->flags & PIC_PORT_IN) == 0) return pic_false_value(); return pic_bool_value(port->status == PIC_PORT_OPEN); } static pic_value pic_port_output_port_open_p(pic_state *pic) { pic_value v; struct pic_port *port; pic_get_args(pic, "o", &v); if (! pic_port_p(v)) return pic_false_value(); port = pic_port_ptr(v); if ((port->flags & PIC_PORT_OUT) == 0) return pic_false_value(); return pic_bool_value(port->status == PIC_PORT_OPEN); } static pic_value pic_port_eof_object_p(pic_state *pic) { pic_value v; pic_get_args(pic, "o", &v); if (pic_vtype(v) == PIC_VTYPE_EOF) { return pic_true_value(); } else { return pic_false_value(); } } static pic_value pic_port_eof_object(pic_state *pic) { pic_get_args(pic, ""); return pic_eof_object(); } static pic_value pic_port_close_port(pic_state *pic) { struct pic_port *port; pic_get_args(pic, "p", &port); if (pic_fclose(port->file) == EOF) { pic_error(pic, "close-port: failure"); } port->status = PIC_PORT_CLOSE; return pic_none_value(); } #define assert_port_profile(port, flgs, stat, caller) do { \ if ((port->flags & (flgs)) != (flgs)) { \ switch (flgs) { \ case PIC_PORT_IN: \ pic_error(pic, caller ": expected output port"); \ case PIC_PORT_OUT: \ pic_error(pic, caller ": expected input port"); \ case PIC_PORT_IN | PIC_PORT_TEXT: \ pic_error(pic, caller ": expected input/textual port"); \ case PIC_PORT_IN | PIC_PORT_BINARY: \ pic_error(pic, caller ": expected input/binary port"); \ case PIC_PORT_OUT | PIC_PORT_TEXT: \ pic_error(pic, caller ": expected output/textual port"); \ case PIC_PORT_OUT | PIC_PORT_BINARY: \ pic_error(pic, caller ": expected output/binary port"); \ } \ } \ if (port->status != stat) { \ switch (stat) { \ case PIC_PORT_OPEN: \ pic_error(pic, caller ": expected open port"); \ case PIC_PORT_CLOSE: \ pic_error(pic, caller ": expected close port"); \ } \ } \ } while (0) static pic_value pic_port_read_char(pic_state *pic) { char c; struct pic_port *port = pic_stdin(pic); pic_get_args(pic, "|p", &port); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "read-char"); if ((c = pic_fgetc(port->file)) == EOF) { return pic_eof_object(); } else { return pic_char_value(c); } } static pic_value pic_port_peek_char(pic_state *pic) { char c; struct pic_port *port = pic_stdin(pic); pic_get_args(pic, "|p", &port); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "peek-char"); if ((c = pic_fgetc(port->file)) == EOF) { return pic_eof_object(); } else { pic_ungetc(c, port->file); return pic_char_value(c); } } static pic_value pic_port_newline(pic_state *pic) { struct pic_port *port = pic_stdout(pic); pic_get_args(pic, "|p", &port); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "newline"); pic_fputs("\n", port->file); return pic_none_value(); } static pic_value pic_port_write_char(pic_state *pic) { char c; struct pic_port *port = pic_stdout(pic); pic_get_args(pic, "c|p", &c, &port); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "write-char"); pic_fputc(c, port->file); return pic_none_value(); } static pic_value pic_port_flush(pic_state *pic) { struct pic_port *port = pic_stdout(pic); pic_get_args(pic, "|p", &port); assert_port_profile(port, PIC_PORT_OUT, PIC_PORT_OPEN, "flush-output-port"); pic_fflush(port->file); return pic_none_value(); } void pic_init_port(pic_state *pic) { pic_defvar(pic, "current-input-port", port_new_stdio(pic, stdin, PIC_PORT_IN)); pic_defvar(pic, "current-output-port", port_new_stdio(pic, stdout, PIC_PORT_OUT)); pic_defvar(pic, "current-error-port", port_new_stdio(pic, stderr, PIC_PORT_OUT)); pic_defun(pic, "input-port?", pic_port_input_port_p); pic_defun(pic, "output-port?", pic_port_output_port_p); pic_defun(pic, "textual-port?", pic_port_textual_port_p); pic_defun(pic, "binary-port?", pic_port_binary_port_p); pic_defun(pic, "port?", pic_port_port_p); pic_defun(pic, "input-port-open?", pic_port_input_port_open_p); pic_defun(pic, "output-port-open?", pic_port_output_port_open_p); pic_defun(pic, "eof-object?", pic_port_eof_object_p); pic_defun(pic, "eof-object", pic_port_eof_object); pic_defun(pic, "close-port", pic_port_close_port); pic_defun(pic, "close-input-port", pic_port_close_port); pic_defun(pic, "close-output-port", pic_port_close_port); /* input */ pic_defun(pic, "read-char", pic_port_read_char); pic_defun(pic, "peek-char", pic_port_peek_char); /* write */ pic_defun(pic, "newline", pic_port_newline); pic_defun(pic, "write-char", pic_port_write_char); pic_defun(pic, "flush-output-port", pic_port_flush); }