picrin/lib/port.c

812 lines
18 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
2016-02-20 10:58:58 -05:00
#include "picrin/extra.h"
2016-06-19 15:49:01 -04:00
#include "picrin/private/state.h"
2016-02-20 11:13:16 -05:00
#include "picrin/private/object.h"
#include "picrin/private/file.h"
2014-08-25 00:38:09 -04:00
2016-06-19 15:49:01 -04:00
#ifndef EOF
# define EOF (-1)
#endif
2016-02-19 00:50:12 -05:00
2016-02-20 02:51:24 -05:00
pic_value
2016-06-19 15:49:01 -04:00
pic_funopen(pic_state *pic, 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 *))
{
2016-02-21 06:32:00 -05:00
struct port *port;
2016-02-21 06:32:00 -05:00
port = (struct port *)pic_obj_alloc(pic, sizeof(struct port), PIC_TYPE_PORT);
2016-07-10 10:50:41 -04:00
port->file.cnt = 0;
port->file.base = NULL;
port->file.flag = read? FILE_READ : FILE_WRITE;
port->file.vtable.cookie = cookie;
port->file.vtable.read = read;
port->file.vtable.write = write;
port->file.vtable.seek = seek;
port->file.vtable.close = close;
2016-02-20 02:51:24 -05:00
return pic_obj_value(port);
}
2016-06-19 15:49:01 -04:00
int
pic_fclose(pic_state *pic, pic_value port)
2016-02-20 02:51:24 -05:00
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
2016-07-10 11:40:58 -04:00
if (fp->flag == 0)
return 0;
2016-06-19 15:49:01 -04:00
pic_fflush(pic, port);
fp->flag = 0;
if (fp->base != fp->buf)
pic_free(pic, fp->base);
return fp->vtable.close(pic, fp->vtable.cookie);
2014-08-25 00:38:09 -04:00
}
void
2016-06-19 15:49:01 -04:00
pic_clearerr(pic_state *PIC_UNUSED(pic), pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
fp->flag &= ~(FILE_EOF | FILE_ERR);
}
int
pic_feof(pic_state *PIC_UNUSED(pic), pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
return (fp->flag & FILE_EOF) != 0;
}
int
pic_ferror(pic_state *PIC_UNUSED(pic), pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
return (fp->flag & FILE_ERR) != 0;
}
static int
fillbuf(pic_state *pic, struct file *fp)
{
int bufsize;
if ((fp->flag & (FILE_READ|FILE_EOF|FILE_ERR)) != FILE_READ)
return EOF;
if (fp->base == NULL) {
if ((fp->flag & FILE_UNBUF) == 0) {
/* no buffer yet */
if ((fp->base = pic_malloc(pic, PIC_BUFSIZ)) == NULL) {
/* can't get buffer, try unbuffered */
fp->flag |= FILE_UNBUF;
}
}
if (fp->flag & FILE_UNBUF) {
fp->base = fp->buf;
}
}
bufsize = (fp->flag & FILE_UNBUF) ? sizeof(fp->buf) : PIC_BUFSIZ;
fp->ptr = fp->base;
fp->cnt = fp->vtable.read(pic, fp->vtable.cookie, fp->ptr, bufsize);
if (--fp->cnt < 0) {
if (fp->cnt == -1)
fp->flag |= FILE_EOF;
else
fp->flag |= FILE_ERR;
fp->cnt = 0;
return EOF;
}
return (unsigned char) *fp->ptr++;
}
static int
flushbuf(pic_state *pic, int x, struct file *fp)
{
int num_written=0, bufsize=0;
char c = x;
if ((fp->flag & (FILE_WRITE|FILE_EOF|FILE_ERR)) != FILE_WRITE)
return EOF;
if (fp->base == NULL && ((fp->flag & FILE_UNBUF) == 0)) {
/* no buffer yet */
if ((fp->base = pic_malloc(pic, PIC_BUFSIZ)) == NULL) {
/* couldn't allocate a buffer, so try unbuffered */
fp->flag |= FILE_UNBUF;
} else {
fp->ptr = fp->base;
fp->cnt = PIC_BUFSIZ - 1;
}
}
if (fp->flag & FILE_UNBUF) {
/* unbuffered write */
fp->ptr = fp->base = NULL;
fp->cnt = 0;
if (x == EOF)
return EOF;
num_written = fp->vtable.write(pic, fp->vtable.cookie, (const char *) &c, 1);
bufsize = 1;
} else {
/* buffered write */
assert(fp->ptr);
if (x != EOF) {
*fp->ptr++ = (unsigned char) c;
}
bufsize = (int)(fp->ptr - fp->base);
while(bufsize - num_written > 0) {
int t;
t = fp->vtable.write(pic, fp->vtable.cookie, fp->base + num_written, bufsize - num_written);
if (t < 0)
break;
num_written += t;
}
fp->ptr = fp->base;
fp->cnt = PIC_BUFSIZ - 1;
}
if (num_written == bufsize) {
return x;
} else {
fp->flag |= FILE_ERR;
return EOF;
}
}
2016-07-10 10:20:21 -04:00
int
pic_fflush(pic_state *pic, pic_value port)
2016-06-19 15:49:01 -04:00
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
int retval;
retval = 0;
2016-07-10 10:20:21 -04:00
if ((fp->flag & FILE_WRITE) == 0)
return -1;
flushbuf(pic, EOF, fp);
if (fp->flag & FILE_ERR)
retval = -1;
2016-06-19 15:49:01 -04:00
return retval;
}
#define getc_(pic, p) \
((--(p)->cnt >= 0) \
? (unsigned char) *(p)->ptr++ \
: fillbuf((pic), p))
#define putc_(pic, x, p) \
((--(p)->cnt >= 0 && !(((p)->flag & FILE_LNBUF) && (x) == '\n')) \
? *(p)->ptr++ = (x) \
: flushbuf((pic), (x), (p)))
int
pic_fputc(pic_state *pic, int x, pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
return putc_(pic, x, fp);
}
int
pic_fgetc(pic_state *pic, pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
return getc_(pic, fp);
}
int
pic_fputs(pic_state *pic, const char *s, pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
const char *ptr = s;
while(*ptr != '\0') {
if (putc_(pic, *ptr, fp) == EOF)
return EOF;
++ptr;
}
return (int)(ptr - s);
}
char *
pic_fgets(pic_state *pic, char *s, int size, pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
int c = 0;
char *buf;
2016-07-08 22:27:00 -04:00
pic_fflush(pic, port);
2016-06-19 15:49:01 -04:00
if (size == 0) {
return NULL;
}
buf = s;
while (--size > 0 && (c = getc_(pic, fp)) != EOF) {
if ((*buf++ = c) == '\n')
break;
}
*buf = '\0';
return (c == EOF && buf == s) ? NULL : s;
}
int
pic_ungetc(pic_state *PIC_UNUSED(pic), int c, pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
unsigned char uc = c;
if (c == EOF || fp->base == fp->ptr) {
return EOF;
}
fp->cnt++;
return *--fp->ptr = uc;
}
size_t
pic_fread(pic_state *pic, void *ptr, size_t size, size_t count, pic_value port)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
char *bptr = ptr;
long nbytes;
int c;
nbytes = size * count;
while (nbytes > fp->cnt) {
memcpy(bptr, fp->ptr, fp->cnt);
fp->ptr += fp->cnt;
bptr += fp->cnt;
nbytes -= fp->cnt;
if ((c = fillbuf(pic, fp)) == EOF) {
return (size * count - nbytes) / size;
} else {
pic_ungetc(pic, c, port);
}
}
memcpy(bptr, fp->ptr, nbytes);
fp->ptr += nbytes;
fp->cnt -= nbytes;
return count;
}
size_t
pic_fwrite(pic_state *pic, const void *ptr, size_t size, size_t count, pic_value port)
2014-08-25 00:38:09 -04:00
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
const char *bptr = ptr;
long nbytes;
nbytes = size * count;
while (nbytes > fp->cnt) {
memcpy(fp->ptr, bptr, fp->cnt);
fp->ptr += fp->cnt;
bptr += fp->cnt;
nbytes -= fp->cnt;
if (flushbuf(pic, EOF, fp) == EOF) {
return (size * count - nbytes) / size;
}
}
memcpy(fp->ptr, bptr, nbytes);
fp->ptr += nbytes;
fp->cnt -= nbytes;
return count;
}
long
pic_fseek(pic_state *pic, pic_value port, long offset, int whence)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
long s;
pic_fflush(pic, port);
fp->ptr = fp->base;
fp->cnt = 0;
if ((s = fp->vtable.seek(pic, fp->vtable.cookie, offset, whence)) != 0)
return s;
fp->flag &= ~FILE_EOF;
return 0;
}
#if PIC_USE_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 PIC_SEEK_CUR:
whence = SEEK_CUR;
break;
case PIC_SEEK_SET:
whence = SEEK_SET;
break;
case PIC_SEEK_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);
}
pic_value
pic_fopen(pic_state *pic, FILE *fp, const char *mode) {
if (*mode == 'r') {
return pic_funopen(pic, fp, file_read, 0, file_seek, file_close);
} else {
return pic_funopen(pic, fp, 0, file_write, file_seek, file_close);
}
}
#else
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;
}
static pic_value
pic_fopen_null(pic_state *PIC_UNUSED(pic), const char *mode)
{
switch (*mode) {
case 'r':
return pic_funopen(pic, 0, null_read, 0, null_seek, null_close);
default:
return pic_funopen(pic, 0, 0, null_write, null_seek, null_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;
}
2016-02-20 02:51:24 -05:00
2016-06-19 15:49:01 -04:00
static long
string_seek(pic_state *PIC_UNUSED(pic), void *cookie, long pos, int whence)
{
xbuf_t *m = cookie;
switch (whence) {
case PIC_SEEK_SET:
m->pos = pos;
break;
case PIC_SEEK_CUR:
m->pos += pos;
break;
case PIC_SEEK_END:
m->pos = m->end + pos;
break;
2015-06-18 12:04:04 -04:00
}
2016-06-19 15:49:01 -04:00
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;
}
pic_value
pic_fmemopen(pic_state *pic, const char *data, int size, const char *mode)
{
xbuf_t *m;
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);
return pic_funopen(pic, m, string_read, NULL, string_seek, string_close);
} else {
return pic_funopen(pic, m, NULL, string_write, string_seek, string_close);
}
}
int
pic_fgetbuf(pic_state *pic, pic_value port, const char **buf, int *len)
{
2016-07-10 10:50:41 -04:00
struct file *fp = &pic_port_ptr(pic, port)->file;
2016-06-19 15:49:01 -04:00
xbuf_t *s;
pic_fflush(pic, port);
if (fp->vtable.write != string_write) {
return -1;
2014-08-25 00:38:09 -04:00
}
2016-06-19 15:49:01 -04:00
s = fp->vtable.cookie;
*len = s->end;
*buf = s->buf;
return 0;
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);
2016-07-10 10:50:41 -04:00
if (pic_port_p(pic, v) && (pic_port_ptr(pic, v)->file.flag & FILE_READ) != 0) {
return pic_true_value(pic);
2016-02-18 15:54:50 -05:00
} else {
return pic_false_value(pic);
2014-08-25 00:38:09 -04:00
}
}
static pic_value
pic_port_output_port_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
2016-07-10 10:50:41 -04:00
if (pic_port_p(pic, v) && (pic_port_ptr(pic, v)->file.flag & FILE_WRITE) != 0) {
return pic_true_value(pic);
2014-08-25 00:38:09 -04:00
}
else {
return pic_false_value(pic);
2014-08-25 00:38:09 -04:00
}
}
static pic_value
pic_port_port_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_bool_value(pic, pic_port_p(pic, v));
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_eof_object_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_bool_value(pic, pic_eof_p(pic, v));
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_eof_object(pic_state *pic)
{
pic_get_args(pic, "");
return pic_eof_object(pic);
2014-08-25 00:38:09 -04:00
}
2014-09-08 13:12:51 -04:00
static pic_value
pic_port_port_open_p(pic_state *pic)
{
2016-02-20 02:51:24 -05:00
pic_value port;
2014-09-08 13:12:51 -04:00
pic_get_args(pic, "p", &port);
2016-07-10 10:50:41 -04:00
return pic_bool_value(pic, pic_port_ptr(pic, port)->file.flag != 0);
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)
{
2016-02-20 02:51:24 -05:00
pic_value port;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "p", &port);
2016-06-19 15:49:01 -04:00
pic_fclose(pic, port);
2014-08-25 00:38:09 -04:00
return pic_undef_value(pic);
2014-08-25 00:38:09 -04:00
}
2016-06-19 15:49:01 -04:00
#define assert_port_profile(port, flags, caller) do { \
2016-07-10 10:50:41 -04:00
int flag = pic_port_ptr(pic, port)->file.flag; \
2016-06-19 15:49:01 -04:00
if ((flag & (flags)) != (flags)) { \
switch (flags) { \
case FILE_WRITE: \
pic_error(pic, caller ": output port required", 0); \
case FILE_READ: \
pic_error(pic, caller ": input port required", 0); \
} \
} \
if (flag == 0) { \
pic_error(pic, caller ": open port required", 0); \
} \
2014-08-25 00:38:09 -04:00
} while (0)
static pic_value
2016-02-18 15:54:50 -05:00
pic_port_open_input_bytevector(pic_state *pic)
2014-08-25 00:38:09 -04:00
{
2016-02-19 09:22:41 -05:00
unsigned char *buf;
int len;
2014-08-25 00:38:09 -04:00
2016-02-20 07:16:10 -05:00
pic_get_args(pic, "b", &buf, &len);
2014-08-25 00:38:09 -04:00
2016-06-19 15:49:01 -04:00
return pic_fmemopen(pic, (char *)buf, len, "r");
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_open_output_bytevector(pic_state *pic)
{
pic_get_args(pic, "");
2016-06-19 15:49:01 -04:00
return pic_fmemopen(pic, NULL, 0, "w");
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_get_output_bytevector(pic_state *pic)
{
2016-02-20 02:51:24 -05:00
pic_value port = pic_stdout(pic);
2016-02-18 15:54:50 -05:00
const char *buf;
int len;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "|p", &port);
2016-06-19 15:49:01 -04:00
assert_port_profile(port, FILE_WRITE, "get-output-bytevector");
2014-08-25 00:38:09 -04:00
2016-06-19 15:49:01 -04:00
if (pic_fgetbuf(pic, port, &buf, &len) < 0) {
2016-02-22 14:03:42 -05:00
pic_error(pic, "port was not created by open-output-bytevector", 0);
2015-05-28 10:28:55 -04:00
}
2016-02-19 09:22:41 -05:00
return pic_blob_value(pic, (unsigned char *)buf, len);
2014-08-25 00:38:09 -04:00
}
static pic_value
2016-07-10 10:20:21 -04:00
pic_port_read_u8(pic_state *pic)
{
2016-02-20 02:51:24 -05:00
pic_value port = pic_stdin(pic);
2014-08-25 00:38:09 -04:00
int c;
2016-07-10 10:20:21 -04:00
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "|p", &port);
2016-06-19 15:49:01 -04:00
assert_port_profile(port, FILE_READ, "read-u8");
if ((c = pic_fgetc(pic, port)) == EOF) {
return pic_eof_object(pic);
2014-08-25 00:38:09 -04:00
}
return pic_int_value(pic, c);
2014-08-25 00:38:09 -04:00
}
static pic_value
2016-02-18 15:54:50 -05:00
pic_port_peek_u8(pic_state *pic)
2014-08-25 00:38:09 -04:00
{
int c;
2016-02-20 02:51:24 -05:00
pic_value port = pic_stdin(pic);
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "|p", &port);
2016-06-19 15:49:01 -04:00
assert_port_profile(port, FILE_READ, "peek-u8");
2014-08-25 00:38:09 -04:00
2016-06-19 15:49:01 -04:00
c = pic_fgetc(pic, port);
2014-08-25 00:38:09 -04:00
if (c == EOF) {
return pic_eof_object(pic);
2014-08-25 00:38:09 -04:00
}
else {
2016-06-19 15:49:01 -04:00
pic_ungetc(pic, c, port);
return pic_int_value(pic, c);
2014-08-25 00:38:09 -04:00
}
}
static pic_value
pic_port_read_bytevector_ip(pic_state *pic)
2014-08-25 00:38:09 -04:00
{
2016-02-20 07:16:10 -05:00
pic_value port;
2016-02-19 09:22:41 -05:00
unsigned char *buf;
2015-08-26 06:04:27 -04:00
int n, start, end, i, len;
2014-08-25 00:38:09 -04:00
2016-02-20 07:16:10 -05:00
n = pic_get_args(pic, "b|pii", &buf, &len, &port, &start, &end);
2016-02-19 09:22:41 -05:00
2014-08-25 00:38:09 -04:00
switch (n) {
case 1:
port = pic_stdin(pic);
case 2:
start = 0;
case 3:
2016-02-19 09:22:41 -05:00
end = len;
2014-08-25 00:38:09 -04:00
}
2016-02-19 09:22:41 -05:00
VALID_RANGE(pic, len, start, end);
2016-06-19 15:49:01 -04:00
assert_port_profile(port, FILE_READ, "read-bytevector!");
2014-09-26 03:13:53 -04:00
2016-06-19 15:49:01 -04:00
i = pic_fread(pic, buf + start, 1, end - start, port);
2014-09-26 03:13:53 -04:00
if (i == 0) {
return pic_eof_object(pic);
2014-08-25 00:38:09 -04:00
}
2016-02-19 09:22:41 -05:00
return pic_int_value(pic, i);
2014-08-25 00:38:09 -04:00
}
static pic_value
2016-02-18 15:54:50 -05:00
pic_port_write_u8(pic_state *pic)
2014-08-25 00:38:09 -04:00
{
int i;
2016-02-20 02:51:24 -05:00
pic_value port = pic_stdout(pic);
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "i|p", &i, &port);
2016-06-19 15:49:01 -04:00
assert_port_profile(port, FILE_WRITE, "write-u8");
2014-08-25 00:38:09 -04:00
2016-06-19 15:49:01 -04:00
pic_fputc(pic, i, port);
return pic_undef_value(pic);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_write_bytevector(pic_state *pic)
2014-08-25 00:38:09 -04:00
{
2016-02-20 02:51:24 -05:00
pic_value port;
2016-02-19 09:22:41 -05:00
unsigned char *buf;
int n, start, end, len, done;
2014-08-25 00:38:09 -04:00
2016-02-20 07:16:10 -05:00
n = pic_get_args(pic, "b|pii", &buf, &len, &port, &start, &end);
2016-02-19 09:22:41 -05:00
2014-08-25 00:38:09 -04:00
switch (n) {
case 1:
port = pic_stdout(pic);
case 2:
start = 0;
case 3:
2016-02-19 09:22:41 -05:00
end = len;
2014-08-25 00:38:09 -04:00
}
2016-02-19 09:22:41 -05:00
VALID_RANGE(pic, len, start, end);
2016-06-19 15:49:01 -04:00
assert_port_profile(port, FILE_WRITE, "write-bytevector");
2014-08-25 00:38:09 -04:00
2016-02-19 09:22:41 -05:00
done = 0;
while (done < end - start) {
2016-06-19 15:49:01 -04:00
done += pic_fwrite(pic, buf + start + done, 1, end - start - done, port);
2016-02-19 09:22:41 -05:00
/* FIXME: error check... */
2014-08-25 00:38:09 -04:00
}
return pic_undef_value(pic);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_flush(pic_state *pic)
{
2016-02-20 02:51:24 -05:00
pic_value port = pic_stdout(pic);
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "|p", &port);
2016-06-19 15:49:01 -04:00
assert_port_profile(port, FILE_WRITE, "flush-output-port");
2014-08-25 00:38:09 -04:00
2016-06-19 15:49:01 -04:00
pic_fflush(pic, port);
return pic_undef_value(pic);
2014-08-25 00:38:09 -04:00
}
2016-02-18 15:54:50 -05:00
static pic_value
coerce_port(pic_state *pic)
{
2016-02-20 02:51:24 -05:00
pic_value port;
2016-02-18 15:54:50 -05:00
pic_get_args(pic, "p", &port);
2016-02-20 02:51:24 -05:00
return port;
2016-02-18 15:54:50 -05:00
}
2016-06-19 15:49:01 -04:00
#if PIC_USE_STDIO
# define DEFINE_PORT(pic, name, file, mode) \
pic_defvar(pic, name, pic_fopen(pic, file, mode), coerce)
#else
# define DEFINE_PORT(pic, name, file, mode) \
pic_defvar(pic, name, pic_fopen_null(pic, mode), coerce)
#endif
2016-02-18 15:54:50 -05:00
2014-08-25 00:38:09 -04:00
void
pic_init_port(pic_state *pic)
{
2016-02-19 10:03:16 -05:00
pic_value coerce = pic_lambda(pic, coerce_port, 0);
2016-02-18 15:54:50 -05:00
2016-06-19 15:49:01 -04:00
DEFINE_PORT(pic, "current-input-port", stdin, "r");
DEFINE_PORT(pic, "current-output-port", stdout, "w");
DEFINE_PORT(pic, "current-error-port", stderr, "w");
2014-08-25 00:38:09 -04:00
pic_defun(pic, "port?", pic_port_port_p);
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);
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);
pic_defun(pic, "eof-object?", pic_port_eof_object_p);
pic_defun(pic, "eof-object", pic_port_eof_object);
2014-08-25 00:38:09 -04:00
/* input */
2016-02-18 15:54:50 -05:00
pic_defun(pic, "read-u8", pic_port_read_u8);
pic_defun(pic, "peek-u8", pic_port_peek_u8);
pic_defun(pic, "read-bytevector!", pic_port_read_bytevector_ip);
2014-08-25 00:38:09 -04:00
/* output */
2016-02-18 15:54:50 -05:00
pic_defun(pic, "write-u8", pic_port_write_u8);
pic_defun(pic, "write-bytevector", pic_port_write_bytevector);
2014-08-25 00:38:09 -04:00
pic_defun(pic, "flush-output-port", pic_port_flush);
2016-02-18 15:54:50 -05:00
/* 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);
2014-08-25 00:38:09 -04:00
}