picrin/extlib/benz/port.c

961 lines
22 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
pic_value
pic_eof_object()
{
pic_value v;
pic_init_value(v, PIC_VTYPE_EOF);
return v;
}
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 */
2015-06-19 01:03:52 -04:00
#if PIC_ENABLE_STDIO
2015-06-18 16:00:36 -04:00
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;
}
2015-06-18 16:13:57 -04:00
if (fseek(cookie, pos, whence) == 0) {
return ftell(cookie);
}
return -1;
2015-06-18 16:00:36 -04:00
}
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);
}
}
2015-07-01 19:50:10 -04:00
PIC_NORETURN static void
file_error(pic_state *pic, const char *msg)
{
struct pic_error *e;
2016-02-07 14:10:22 -05:00
e = pic_make_error(pic, pic_intern_lit(pic, "file"), msg, pic_nil_value());
2015-07-01 19:50:10 -04:00
pic_raise(pic, pic_obj_value(e));
}
2015-06-18 16:00:36 -04:00
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) {
2015-07-01 19:50:10 -04:00
file_error(pic, pic_str_cstr(pic, pic_format(pic, "could not open file '%s'", name)));
2015-06-18 16:00:36 -04:00
}
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
port->file = file;
port->flags = flags | PIC_PORT_OPEN;
return port;
}
2015-06-19 01:03:52 -04:00
#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)
{
struct pic_port *port;
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
port->file = file;
port->flags = dir | PIC_PORT_TEXT | PIC_PORT_OPEN;
2015-06-27 06:02:18 -04:00
pic_defvar(pic, name, pic_obj_value(port), pic_make_proc(pic, 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); \
}
2014-08-25 00:38:09 -04:00
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")
2014-08-25 00:38:09 -04:00
2015-05-27 12:58:22 -04:00
struct strfile {
char *buf;
long pos, end, capa;
};
static int
string_read(pic_state PIC_UNUSED(*pic), void *cookie, char *ptr, int size)
2015-05-27 12:58:22 -04:00
{
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)
2015-05-27 12:58:22 -04:00
{
struct strfile *m = cookie;
if (m->pos + size >= m->capa) {
m->capa = (m->pos + size) * 2;
2015-08-26 06:04:27 -04:00
m->buf = pic_realloc(pic, m->buf, m->capa);
2015-05-27 12:58:22 -04:00
}
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)
2015-05-27 12:58:22 -04:00
{
struct strfile *m = cookie;
switch (whence) {
2015-05-28 10:28:55 -04:00
case XSEEK_SET:
2015-05-27 12:58:22 -04:00
m->pos = pos;
break;
2015-05-28 10:28:55 -04:00
case XSEEK_CUR:
2015-05-27 12:58:22 -04:00
m->pos += pos;
break;
2015-05-28 10:28:55 -04:00
case XSEEK_END:
2015-05-27 12:58:22 -04:00
m->pos = m->end + pos;
break;
}
return m->pos;
}
static int
string_close(pic_state *pic, void *cookie)
2015-05-27 12:58:22 -04:00
{
struct strfile *m = cookie;
pic_free(pic, m->buf);
pic_free(pic, m);
2015-05-27 12:58:22 -04:00
return 0;
}
static xFILE *
2015-05-28 10:28:55 -04:00
string_open(pic_state *pic, const char *data, size_t size)
2015-05-27 12:58:22 -04:00
{
struct strfile *m;
xFILE *file;
m = pic_malloc(pic, sizeof(struct strfile));
m->buf = pic_malloc(pic, size);
m->pos = 0;
2015-05-28 10:28:55 -04:00
m->end = size;
2015-05-27 12:58:22 -04:00
m->capa = size;
2015-05-28 10:28:55 -04:00
if (data != NULL) {
2015-05-31 08:26:06 -04:00
memcpy(m->buf, data, size);
2015-06-18 14:06:57 -04:00
file = xfunopen(pic, m, string_read, NULL, string_seek, string_close);
2015-05-28 10:28:55 -04:00
} else {
2015-06-18 14:06:57 -04:00
file = xfunopen(pic, m, NULL, string_write, string_seek, string_close);
2015-05-28 10:28:55 -04:00
}
2015-05-27 12:58:22 -04:00
if (file == NULL) {
string_close(pic, m);
2015-05-27 12:58:22 -04:00
pic_error(pic, "could not open new output string/bytevector port", pic_nil_value());
}
return file;
}
2014-08-25 00:38:09 -04:00
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_TT_PORT);
2015-05-28 10:28:55 -04:00
port->file = string_open(pic, str, strlen(str));
2015-06-18 10:26:31 -04:00
port->flags = PIC_PORT_IN | PIC_PORT_TEXT | PIC_PORT_OPEN;
2014-08-25 00:38:09 -04:00
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_TT_PORT);
2015-05-28 10:28:55 -04:00
port->file = string_open(pic, NULL, 0);
2015-06-18 10:26:31 -04:00
port->flags = PIC_PORT_OUT | PIC_PORT_TEXT | PIC_PORT_OPEN;
2014-08-25 00:38:09 -04:00
return port;
}
struct pic_string *
pic_get_output_string(pic_state *pic, struct pic_port *port)
{
2015-05-28 10:28:55 -04:00
struct strfile *s;
if (port->file->vtable.write != string_write) {
pic_errorf(pic, "get-output-string: port is not made by open-output-string");
}
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
xfflush(pic, port->file);
2014-08-25 00:38:09 -04:00
2015-05-28 10:28:55 -04:00
s = port->file->vtable.cookie;
2014-08-25 00:38:09 -04:00
2015-05-28 10:28:55 -04:00
return pic_make_str(pic, s->buf, s->end);
2014-08-25 00:38:09 -04:00
}
void
pic_close_port(pic_state *pic, struct pic_port *port)
{
2015-06-18 12:04:04 -04:00
if ((port->flags & PIC_PORT_OPEN) == 0) {
return;
}
2015-06-18 13:05:56 -04:00
if (xfclose(pic, port->file) == EOF) {
2014-09-16 10:43:15 -04:00
pic_errorf(pic, "close-port: failure");
2014-08-25 00:38:09 -04:00
}
2015-06-18 10:26:31 -04:00
port->flags &= ~PIC_PORT_OPEN;
2014-08-25 00:38:09 -04:00
}
2014-09-10 04:42:55 -04:00
static pic_value
pic_port_call_with_port(pic_state *pic)
{
struct pic_port *port;
struct pic_proc *proc;
pic_value value;
pic_get_args(pic, "pl", &port, &proc);
value = pic_apply1(pic, proc, pic_obj_value(port));
pic_close_port(pic, port);
return value;
}
2014-08-25 00:38:09 -04:00
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_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();
}
2014-09-08 13:12:51 -04:00
static pic_value
pic_port_port_open_p(pic_state *pic)
{
struct pic_port *port;
pic_get_args(pic, "p", &port);
2015-06-18 10:26:31 -04:00
return pic_bool_value(port->flags & PIC_PORT_OPEN);
2014-09-08 13:12:51 -04:00
}
2014-08-25 00:38:09 -04:00
static pic_value
pic_port_close_port(pic_state *pic)
{
struct pic_port *port;
pic_get_args(pic, "p", &port);
pic_close_port(pic, port);
2015-06-09 03:34:45 -04:00
return pic_undef_value();
2014-08-25 00:38:09 -04:00
}
2015-06-18 10:26:31 -04:00
#define assert_port_profile(port, flgs, caller) do { \
2014-08-25 00:38:09 -04:00
if ((port->flags & (flgs)) != (flgs)) { \
switch (flgs) { \
case PIC_PORT_IN: \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, caller ": expected output port"); \
2014-08-25 00:38:09 -04:00
case PIC_PORT_OUT: \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, caller ": expected input port"); \
2014-08-25 00:38:09 -04:00
case PIC_PORT_IN | PIC_PORT_TEXT: \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, caller ": expected input/textual port"); \
2014-08-25 00:38:09 -04:00
case PIC_PORT_IN | PIC_PORT_BINARY: \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, caller ": expected input/binary port"); \
2014-08-25 00:38:09 -04:00
case PIC_PORT_OUT | PIC_PORT_TEXT: \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, caller ": expected output/textual port"); \
2014-08-25 00:38:09 -04:00
case PIC_PORT_OUT | PIC_PORT_BINARY: \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, caller ": expected output/binary port"); \
2014-08-25 00:38:09 -04:00
} \
} \
2015-06-18 10:26:31 -04:00
if ((port->flags & PIC_PORT_OPEN) == 0) { \
pic_errorf(pic, caller ": expected open port"); \
2014-08-25 00:38:09 -04:00
} \
} while (0)
static pic_value
pic_port_open_input_string(pic_state *pic)
{
struct pic_port *port;
char *str;
pic_get_args(pic, "z", &str);
port = pic_open_input_string(pic, str);
return pic_obj_value(port);
}
static pic_value
pic_port_open_output_string(pic_state *pic)
{
struct pic_port *port;
pic_get_args(pic, "");
port = pic_open_output_string(pic);
return pic_obj_value(port);
}
static pic_value
pic_port_get_output_string(pic_state *pic)
{
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "get-output-string");
2014-08-25 00:38:09 -04:00
return pic_obj_value(pic_get_output_string(pic, port));
}
static pic_value
pic_port_open_input_blob(pic_state *pic)
{
struct pic_port *port;
struct pic_blob *blob;
pic_get_args(pic, "b", &blob);
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
2015-05-28 10:28:55 -04:00
port->file = string_open(pic, (const char *)blob->data, blob->len);
2015-06-18 10:26:31 -04:00
port->flags = PIC_PORT_IN | PIC_PORT_BINARY | PIC_PORT_OPEN;
2014-08-25 00:38:09 -04:00
return pic_obj_value(port);
}
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_TT_PORT);
2015-05-28 10:28:55 -04:00
port->file = string_open(pic, NULL, 0);
2015-06-18 10:26:31 -04:00
port->flags = PIC_PORT_OUT | PIC_PORT_BINARY | PIC_PORT_OPEN;
2014-08-25 00:38:09 -04:00
return pic_obj_value(port);
}
static pic_value
pic_port_get_output_bytevector(pic_state *pic)
{
struct pic_port *port = pic_stdout(pic);
pic_blob *blob;
2015-05-28 10:28:55 -04:00
struct strfile *s;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "get-output-bytevector");
2014-08-25 00:38:09 -04:00
2015-05-28 10:28:55 -04:00
if (port->file->vtable.write != string_write) {
pic_errorf(pic, "get-output-bytevector: port is not made by open-output-bytevector");
}
2015-06-18 13:05:56 -04:00
xfflush(pic, port->file);
2014-08-25 00:38:09 -04:00
2015-05-28 10:28:55 -04:00
s = port->file->vtable.cookie;
blob = pic_make_blob(pic, s->end);
memcpy(blob->data, s->buf, s->end);
2014-08-25 00:38:09 -04:00
return pic_obj_value(blob);
}
static pic_value
pic_port_read_char(pic_state *pic)
{
int c;
struct pic_port *port = pic_stdin(pic);
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-char");
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
if ((c = xfgetc(pic, port->file)) == EOF) {
2014-08-25 00:38:09 -04:00
return pic_eof_object();
}
else {
return pic_char_value((char)c);
}
}
static pic_value
pic_port_peek_char(pic_state *pic)
{
int c;
struct pic_port *port = pic_stdin(pic);
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "peek-char");
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
if ((c = xfgetc(pic, port->file)) == EOF) {
2014-08-25 00:38:09 -04:00
return pic_eof_object();
}
else {
xungetc(c, port->file);
return pic_char_value((char)c);
}
}
static pic_value
pic_port_read_line(pic_state *pic)
{
int c;
struct pic_port *port = pic_stdin(pic), *buf;
struct pic_string *str;
pic_value res = pic_eof_object();
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-line");
2014-08-25 00:38:09 -04:00
buf = pic_open_output_string(pic);
2015-06-18 13:05:56 -04:00
while ((c = xfgetc(pic, port->file)) != EOF && c != '\n') {
xfputc(pic, c, buf->file);
2014-08-25 00:38:09 -04:00
}
str = pic_get_output_string(pic, buf);
if (pic_str_len(str) == 0 && c == EOF) {
/* EOF */
} else {
res = pic_obj_value(str);
2014-08-25 00:38:09 -04:00
}
pic_close_port(pic, buf);
return res;
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_char_ready_p(pic_state *pic)
{
struct pic_port *port = pic_stdin(pic);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "char-ready?");
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "|p", &port);
return pic_true_value(); /* FIXME: always returns #t */
}
static pic_value
pic_port_read_string(pic_state *pic){
struct pic_port *port = pic_stdin(pic), *buf;
pic_str *str;
int k, i;
int c;
pic_value res = pic_eof_object();
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "i|p", &k, &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-stritg");
2014-08-25 00:38:09 -04:00
c = EOF;
buf = pic_open_output_string(pic);
for(i = 0; i < k; ++i) {
2015-06-18 13:05:56 -04:00
if((c = xfgetc(pic, port->file)) == EOF){
2014-08-25 00:38:09 -04:00
break;
}
2015-06-18 13:05:56 -04:00
xfputc(pic, c, buf->file);
2014-08-25 00:38:09 -04:00
}
str = pic_get_output_string(pic, buf);
if (pic_str_len(str) == 0 && c == EOF) {
/* EOF */
} else {
res = pic_obj_value(str);
2014-08-25 00:38:09 -04:00
}
pic_close_port(pic, buf);
return res;
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_read_byte(pic_state *pic){
struct pic_port *port = pic_stdin(pic);
int c;
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-u8");
2015-06-18 13:05:56 -04:00
if ((c = xfgetc(pic, port->file)) == EOF) {
2014-08-25 00:38:09 -04:00
return pic_eof_object();
}
return pic_int_value(c);
}
static pic_value
pic_port_peek_byte(pic_state *pic)
{
int c;
struct pic_port *port = pic_stdin(pic);
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "peek-u8");
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
c = xfgetc(pic, port->file);
2014-08-25 00:38:09 -04:00
if (c == EOF) {
return pic_eof_object();
}
else {
xungetc(c, port->file);
return pic_int_value(c);
}
}
static pic_value
pic_port_byte_ready_p(pic_state *pic)
{
struct pic_port *port = pic_stdin(pic);
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "u8-ready?");
2014-08-25 00:38:09 -04:00
return pic_true_value(); /* FIXME: always returns #t */
}
static pic_value
pic_port_read_blob(pic_state *pic)
{
struct pic_port *port = pic_stdin(pic);
pic_blob *blob;
2015-08-26 06:04:27 -04:00
int k, i;
2014-08-25 00:38:09 -04:00
2015-08-26 06:04:27 -04:00
pic_get_args(pic, "i|p", &k, &port);
2014-08-25 00:38:09 -04:00
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-bytevector");
2014-08-25 00:38:09 -04:00
2014-09-27 06:48:58 -04:00
blob = pic_make_blob(pic, k);
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
i = xfread(pic, blob->data, sizeof(char), k, port->file);
2014-09-26 03:13:53 -04:00
if (i == 0) {
2014-08-25 00:38:09 -04:00
return pic_eof_object();
}
else {
pic_realloc(pic, blob->data, i);
blob->len = i;
return pic_obj_value(blob);
}
}
static pic_value
pic_port_read_blob_ip(pic_state *pic)
{
struct pic_port *port;
struct pic_blob *bv;
char *buf;
2015-08-26 06:04:27 -04:00
int n, start, end, i, len;
2014-08-25 00:38:09 -04:00
2015-08-26 06:04:27 -04:00
n = pic_get_args(pic, "b|pii", &bv, &port, &start, &end);
2014-08-25 00:38:09 -04:00
switch (n) {
case 1:
port = pic_stdin(pic);
case 2:
start = 0;
case 3:
2014-09-27 06:48:58 -04:00
end = bv->len;
2014-08-25 00:38:09 -04:00
}
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-bytevector!");
2014-09-26 03:13:53 -04:00
2014-09-27 06:48:58 -04:00
if (end < start) {
2014-09-26 03:13:53 -04:00
pic_errorf(pic, "read-bytevector!: end index must be greater than or equal to start index");
}
2014-09-27 06:48:58 -04:00
len = end - start;
2014-08-25 00:38:09 -04:00
buf = pic_calloc(pic, len, sizeof(char));
2015-06-18 13:05:56 -04:00
i = xfread(pic, buf, sizeof(char), len, port->file);
2014-08-25 00:38:09 -04:00
memcpy(bv->data + start, buf, i);
pic_free(pic, buf);
2014-09-26 03:13:53 -04:00
if (i == 0) {
2014-08-25 00:38:09 -04:00
return pic_eof_object();
}
else {
2015-08-26 06:04:27 -04:00
return pic_int_value(i);
2014-08-25 00:38:09 -04:00
}
}
static pic_value
pic_port_newline(pic_state *pic)
{
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "newline");
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
xfputs(pic, "\n", port->file);
2015-06-09 03:34:45 -04:00
return pic_undef_value();
2014-08-25 00:38:09 -04:00
}
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);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "write-char");
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
xfputc(pic, c, port->file);
2015-06-09 03:34:45 -04:00
return pic_undef_value();
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_write_string(pic_state *pic)
{
char *str;
struct pic_port *port;
int start, end, n, i;
n = pic_get_args(pic, "z|pii", &str, &port, &start, &end);
switch (n) {
case 1:
port = pic_stdout(pic);
case 2:
start = 0;
case 3:
end = INT_MAX;
}
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "write-string");
2014-08-25 00:38:09 -04:00
for (i = start; i < end && str[i] != '\0'; ++i) {
2015-06-18 13:05:56 -04:00
xfputc(pic, str[i], port->file);
2014-08-25 00:38:09 -04:00
}
2015-06-09 03:34:45 -04:00
return pic_undef_value();
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_write_byte(pic_state *pic)
{
int i;
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "i|p", &i, &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "write-u8");
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
xfputc(pic, i, port->file);
2015-06-09 03:34:45 -04:00
return pic_undef_value();
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_write_blob(pic_state *pic)
{
struct pic_blob *blob;
struct pic_port *port;
2015-08-26 06:04:27 -04:00
int n, start, end, i;
2014-08-25 00:38:09 -04:00
2015-08-26 06:04:27 -04:00
n = pic_get_args(pic, "b|pii", &blob, &port, &start, &end);
2014-08-25 00:38:09 -04:00
switch (n) {
case 1:
port = pic_stdout(pic);
case 2:
start = 0;
case 3:
2014-09-27 06:48:58 -04:00
end = blob->len;
2014-08-25 00:38:09 -04:00
}
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "write-bytevector");
2014-08-25 00:38:09 -04:00
for (i = start; i < end; ++i) {
2015-06-18 13:05:56 -04:00
xfputc(pic, blob->data[i], port->file);
2014-08-25 00:38:09 -04:00
}
2015-06-09 03:34:45 -04:00
return pic_undef_value();
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_flush(pic_state *pic)
{
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "|p", &port);
2015-06-18 10:26:31 -04:00
assert_port_profile(port, PIC_PORT_OUT, "flush-output-port");
2014-08-25 00:38:09 -04:00
2015-06-18 13:05:56 -04:00
xfflush(pic, port->file);
2015-06-09 03:34:45 -04:00
return pic_undef_value();
2014-08-25 00:38:09 -04:00
}
void
pic_init_port(pic_state *pic)
{
2015-06-19 01:03:52 -04:00
#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
2015-06-18 16:00:36 -04:00
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];
2015-06-19 01:03:52 -04:00
#if PIC_ENABLE_STDIO
2015-06-18 16:00:36 -04:00
pic->files[0].vtable.cookie = stdin;
pic->files[1].vtable.cookie = stdout;
pic->files[2].vtable.cookie = stderr;
2015-06-19 01:03:52 -04:00
#endif
2015-06-18 16:00:36 -04:00
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);
2014-08-25 00:38:09 -04:00
2014-09-10 04:42:55 -04:00
pic_defun(pic, "call-with-port", pic_port_call_with_port);
2014-08-25 00:38:09 -04:00
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);
2014-09-08 13:12:51 -04:00
pic_defun(pic, "port-open?", pic_port_port_open_p);
2014-08-25 00:38:09 -04:00
pic_defun(pic, "close-port", pic_port_close_port);
/* string I/O */
pic_defun(pic, "open-input-string", pic_port_open_input_string);
pic_defun(pic, "open-output-string", pic_port_open_output_string);
pic_defun(pic, "get-output-string", pic_port_get_output_string);
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-char", pic_port_read_char);
pic_defun(pic, "peek-char", pic_port_peek_char);
pic_defun(pic, "read-line", pic_port_read_line);
pic_defun(pic, "eof-object?", pic_port_eof_object_p);
pic_defun(pic, "eof-object", pic_port_eof_object);
pic_defun(pic, "char-ready?", pic_port_char_ready_p);
pic_defun(pic, "read-string", pic_port_read_string);
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-bytevector", pic_port_read_blob);
pic_defun(pic, "read-bytevector!", pic_port_read_blob_ip);
/* output */
pic_defun(pic, "newline", pic_port_newline);
pic_defun(pic, "write-char", pic_port_write_char);
pic_defun(pic, "write-string", pic_port_write_string);
pic_defun(pic, "write-u8", pic_port_write_byte);
pic_defun(pic, "write-bytevector", pic_port_write_blob);
pic_defun(pic, "flush-output-port", pic_port_flush);
}