picrin/extlib/benz/port.c

371 lines
8.2 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-02-18 10:20:15 -05:00
#include "picrin/object.h"
#include "picrin/file.h"
2014-08-25 00:38:09 -04:00
2016-02-19 00:50:12 -05:00
#undef EOF
#define EOF (-1)
2016-02-20 02:51:24 -05:00
pic_value
2016-02-20 04:34:13 -05:00
pic_open_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;
2016-02-20 02:51:24 -05:00
return pic_obj_value(port);
}
xFILE *
pic_fileno(pic_state PIC_UNUSED(*pic), pic_value port)
{
return pic_port_ptr(pic, port)->file;
2014-08-25 00:38:09 -04:00
}
void
2016-02-20 02:51:24 -05:00
pic_close_port(pic_state *pic, pic_value port)
2014-08-25 00:38:09 -04:00
{
2016-02-20 02:51:24 -05:00
xFILE *file = pic_fileno(pic, port);
if (file->flag == 0) {
2015-06-18 12:04:04 -04:00
return;
}
2016-02-20 02:51:24 -05:00
if (xfclose(pic, file) == EOF) {
2014-09-16 10:43:15 -04:00
pic_errorf(pic, "close-port: failure");
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-02-20 02:51:24 -05:00
if (pic_port_p(pic, v) && (pic_fileno(pic, v)->flag & X_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-02-20 02:51:24 -05:00
if (pic_port_p(pic, v) && (pic_fileno(pic, v)->flag & X_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-02-20 02:51:24 -05:00
return pic_bool_value(pic, pic_fileno(pic, port)->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);
pic_close_port(pic, port);
return pic_undef_value(pic);
2014-08-25 00:38:09 -04:00
}
2016-02-18 15:54:50 -05:00
#define assert_port_profile(port, flags, caller) do { \
2016-02-20 02:51:24 -05:00
if ((pic_fileno(pic, port)->flag & (flags)) != (flags)) { \
2016-02-18 15:54:50 -05:00
switch (flags) { \
case X_WRITE: \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, caller ": expected output port"); \
2016-02-18 15:54:50 -05:00
case X_READ: \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, caller ": expected input port"); \
2014-08-25 00:38:09 -04:00
} \
} \
2016-02-20 02:51:24 -05:00
if (pic_fileno(pic, port)->flag == 0) { \
2015-06-18 10:26:31 -04:00
pic_errorf(pic, caller ": expected open port"); \
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-02-20 04:34:13 -05:00
return pic_open_port(pic, xfopen_buf(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-02-20 04:34:13 -05:00
return pic_open_port(pic, xfopen_buf(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-02-18 15:54:50 -05:00
assert_port_profile(port, X_WRITE, "get-output-bytevector");
2014-08-25 00:38:09 -04:00
2016-02-20 02:51:24 -05:00
if (xfget_buf(pic, pic_fileno(pic, port), &buf, &len) < 0) {
2016-02-18 15:54:50 -05:00
pic_errorf(pic, "port was not created by open-output-bytevector");
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-02-18 15:54:50 -05: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;
pic_get_args(pic, "|p", &port);
2016-02-18 15:54:50 -05:00
assert_port_profile(port, X_READ, "read-u8");
2016-02-20 02:51:24 -05:00
if ((c = xfgetc(pic, pic_fileno(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-02-18 15:54:50 -05:00
assert_port_profile(port, X_READ, "peek-u8");
2014-08-25 00:38:09 -04:00
2016-02-20 02:51:24 -05:00
c = xfgetc(pic, pic_fileno(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-02-20 03:59:46 -05:00
xungetc(pic, c, pic_fileno(pic, port));
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_u8_ready_p(pic_state *pic)
2014-08-25 00:38:09 -04:00
{
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-02-18 15:54:50 -05:00
assert_port_profile(port, X_READ, "u8-ready?");
2014-08-25 00:38:09 -04:00
2016-02-18 15:54:50 -05:00
return pic_true_value(pic); /* FIXME: always returns #t */
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_port_read_bytevector(pic_state *pic)
2014-08-25 00:38:09 -04:00
{
2016-02-20 02:51:24 -05:00
pic_value port = pic_stdin(pic);
2016-02-19 09:22:41 -05:00
unsigned char *buf;
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
2016-02-18 15:54:50 -05:00
assert_port_profile(port, X_READ, "read-bytevector");
2014-08-25 00:38:09 -04:00
2016-02-19 09:22:41 -05:00
buf = pic_blob(pic, pic_blob_value(pic, NULL, k), NULL);
2014-08-25 00:38:09 -04:00
2016-02-20 02:51:24 -05:00
i = xfread(pic, buf, sizeof(char), k, pic_fileno(pic, 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_blob_value(pic, buf, i);
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-02-18 15:54:50 -05:00
assert_port_profile(port, X_READ, "read-bytevector!");
2014-09-26 03:13:53 -04:00
2016-02-20 02:51:24 -05:00
i = xfread(pic, buf + start, 1, end - start, pic_fileno(pic, 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-02-18 15:54:50 -05:00
assert_port_profile(port, X_WRITE, "write-u8");
2014-08-25 00:38:09 -04:00
2016-02-20 02:51:24 -05:00
xfputc(pic, i, pic_fileno(pic, 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-02-18 15:54:50 -05:00
assert_port_profile(port, X_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-02-20 02:51:24 -05:00
done += xfwrite(pic, buf + start + done, 1, end - start - done, pic_fileno(pic, 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-02-18 15:54:50 -05:00
assert_port_profile(port, X_WRITE, "flush-output-port");
2014-08-25 00:38:09 -04:00
2016-02-20 02:51:24 -05:00
xfflush(pic, pic_fileno(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
}
#define DEFINE_PORT(pic, name, file) \
2016-02-20 04:34:13 -05:00
pic_defvar(pic, name, pic_open_port(pic, file), coerce)
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
DEFINE_PORT(pic, "current-input-port", xstdin);
DEFINE_PORT(pic, "current-output-port", xstdout);
DEFINE_PORT(pic, "current-error-port", xstderr);
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, "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);
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
}