conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add PIC_USE_PORT

This commit is contained in:
Yuichi Nishiwaki 2017-05-12 21:49:03 +09:00
parent cbec7646c0
commit 06dbbcc238
14 changed files with 255 additions and 233 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lib/Makefile
View File

@ -8,7 +8,6 @@ LIBPICRIN_SRCS = \
gc.c\ gc.c\
number.c\ number.c\
pair.c\ pair.c\
port.c\
proc.c\ proc.c\
record.c\ record.c\
serialize.c\ serialize.c\
@ -20,6 +19,7 @@ LIBPICRIN_SRCS = \
vector.c\ vector.c\
ext/cont.c\ ext/cont.c\
ext/eval.c\ ext/eval.c\
ext/port.c\
ext/read.c\ ext/read.c\
ext/write.c\ ext/write.c\
ext/file.c\ ext/file.c\

1
lib/ext/file.c
View File

@ -5,6 +5,7 @@
#include <stdio.h> #include <stdio.h>
#include "picrin.h" #include "picrin.h"
#include "picrin/extra.h"
#include "../value.h" #include "../value.h"
#include "../object.h" #include "../object.h"

134
lib/port.c → lib/ext/port.c
View File

@ -3,47 +3,95 @@
*/ */
#include "picrin.h" #include "picrin.h"
#include "value.h" #include "picrin/extra.h"
#include "object.h"
#include "state.h"
#ifndef EOF #if PIC_USE_PORT
# define EOF (-1)
#endif enum {
FILE_READ = 01,
FILE_WRITE = 02,
FILE_UNBUF = 04,
FILE_EOF = 010,
FILE_ERR = 020,
FILE_LNBUF = 040,
FILE_SETBUF = 0100
};
struct port {
/* buffer */
char buf[1]; /* fallback buffer */
long cnt; /* characters left */
char *ptr; /* next character position */
char *base; /* location of the buffer */
/* operators */
void *cookie;
const pic_port_type *vtable;
int flag; /* mode of the file access */
};
#define port_ptr(pic,obj) ((struct port *) pic_data(pic, (obj)))
#define VALID_RANGE(pic, len, s, e) do { \
if (s < 0 || len < s) \
pic_error(pic, "invalid start index", 1, pic_int_value(pic, s)); \
if (e < s || len < e) \
pic_error(pic, "invalid end index", 1, pic_int_value(pic, e)); \
} while (0)
static int flushbuf(pic_state *, int, struct port *);
static void
port_dtor(pic_state *pic, void *port)
{
struct port *fp = port;
if (fp->flag == 0)
return;
if ((fp->flag & FILE_WRITE) != 0 && fp->base != NULL)
flushbuf(pic, EOF, fp);
if (fp->base != fp->buf && (fp->flag & FILE_SETBUF) == 0)
pic_free(pic, fp->base);
fp->vtable->close(pic, fp->cookie);
pic_free(pic, port);
}
static const pic_data_type port_type = { "port", port_dtor };
pic_value pic_value
pic_funopen(pic_state *pic, void *cookie, const pic_port_type *type) pic_funopen(pic_state *pic, void *cookie, const pic_port_type *type)
{ {
struct port *port; struct port *port;
port = (struct port *)pic_obj_alloc(pic, PIC_TYPE_PORT); port = pic_malloc(pic, sizeof(*port));
port->file.cnt = 0; port->cnt = 0;
port->file.base = NULL; port->base = NULL;
port->file.flag = type->read ? FILE_READ : FILE_WRITE; port->flag = type->read ? FILE_READ : FILE_WRITE;
port->file.cookie = cookie; port->cookie = cookie;
port->file.vtable = type; port->vtable = type;
return obj_value(pic, port); return pic_data_value(pic, port, &port_type);
} }
int int
pic_fclose(pic_state *pic, pic_value port) pic_fclose(pic_state *pic, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
int r;
if (fp->flag == 0) if (fp->flag == 0) /* already closed */
return 0; return 0;
pic_fflush(pic, port); pic_fflush(pic, port);
fp->flag = 0;
if (fp->base != fp->buf && (fp->flag & FILE_SETBUF) == 0) if (fp->base != fp->buf && (fp->flag & FILE_SETBUF) == 0)
pic_free(pic, fp->base); pic_free(pic, fp->base);
return fp->vtable->close(pic, fp->cookie); if ((r = fp->vtable->close(pic, fp->cookie)) < 0)
return r;
fp->flag = 0;
return r;
} }
void void
pic_clearerr(pic_state *pic, pic_value port) pic_clearerr(pic_state *pic, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
fp->flag &= ~(FILE_EOF | FILE_ERR); fp->flag &= ~(FILE_EOF | FILE_ERR);
} }
@ -51,7 +99,7 @@ pic_clearerr(pic_state *pic, pic_value port)
int int
pic_feof(pic_state *pic, pic_value port) pic_feof(pic_state *pic, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
return (fp->flag & FILE_EOF) != 0; return (fp->flag & FILE_EOF) != 0;
} }
@ -59,7 +107,7 @@ pic_feof(pic_state *pic, pic_value port)
int int
pic_ferror(pic_state *pic, pic_value port) pic_ferror(pic_state *pic, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
return (fp->flag & FILE_ERR) != 0; return (fp->flag & FILE_ERR) != 0;
} }
@ -67,7 +115,7 @@ pic_ferror(pic_state *pic, pic_value port)
int int
pic_setvbuf(pic_state *pic, pic_value port, char *buf, int mode, size_t size) pic_setvbuf(pic_state *pic, pic_value port, char *buf, int mode, size_t size)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
fp->flag &= ~(FILE_UNBUF | FILE_LNBUF); fp->flag &= ~(FILE_UNBUF | FILE_LNBUF);
if (mode == PIC_IOLBF) { if (mode == PIC_IOLBF) {
@ -79,7 +127,7 @@ pic_setvbuf(pic_state *pic, pic_value port, char *buf, int mode, size_t size)
if (buf == NULL) { if (buf == NULL) {
return 0; return 0;
} }
if (size != PIC_BUFSIZ) { if (size < PIC_BUFSIZ) {
return EOF; return EOF;
} }
fp->base = buf; fp->base = buf;
@ -88,7 +136,7 @@ pic_setvbuf(pic_state *pic, pic_value port, char *buf, int mode, size_t size)
} }
static int static int
fillbuf(pic_state *pic, struct file *fp) fillbuf(pic_state *pic, struct port *fp)
{ {
int bufsize; int bufsize;
@ -124,7 +172,7 @@ fillbuf(pic_state *pic, struct file *fp)
} }
static int static int
flushbuf(pic_state *pic, int x, struct file *fp) flushbuf(pic_state *pic, int x, struct port *fp)
{ {
int num_written=0, bufsize=0; int num_written=0, bufsize=0;
char c = x; char c = x;
@ -179,7 +227,7 @@ flushbuf(pic_state *pic, int x, struct file *fp)
int int
pic_fflush(pic_state *pic, pic_value port) pic_fflush(pic_state *pic, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
int retval; int retval;
retval = 0; retval = 0;
@ -203,7 +251,7 @@ pic_fflush(pic_state *pic, pic_value port)
int int
pic_fputc(pic_state *pic, int x, pic_value port) pic_fputc(pic_state *pic, int x, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
return putc_(pic, x, fp); return putc_(pic, x, fp);
} }
@ -211,7 +259,7 @@ pic_fputc(pic_state *pic, int x, pic_value port)
int int
pic_fgetc(pic_state *pic, pic_value port) pic_fgetc(pic_state *pic, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
return getc_(pic, fp); return getc_(pic, fp);
} }
@ -219,7 +267,7 @@ pic_fgetc(pic_state *pic, pic_value port)
int int
pic_fputs(pic_state *pic, const char *s, pic_value port) pic_fputs(pic_state *pic, const char *s, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
const char *ptr = s; const char *ptr = s;
while(*ptr != '\0') { while(*ptr != '\0') {
@ -233,7 +281,7 @@ pic_fputs(pic_state *pic, const char *s, pic_value port)
char * char *
pic_fgets(pic_state *pic, char *s, int size, pic_value port) pic_fgets(pic_state *pic, char *s, int size, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
int c = 0; int c = 0;
char *buf; char *buf;
@ -255,7 +303,7 @@ pic_fgets(pic_state *pic, char *s, int size, pic_value port)
int int
pic_ungetc(pic_state *pic, int c, pic_value port) pic_ungetc(pic_state *pic, int c, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
unsigned char uc = c; unsigned char uc = c;
if (c == EOF || fp->base == fp->ptr) { if (c == EOF || fp->base == fp->ptr) {
@ -268,7 +316,7 @@ pic_ungetc(pic_state *pic, int c, pic_value port)
size_t size_t
pic_fread(pic_state *pic, void *ptr, size_t size, size_t count, pic_value port) pic_fread(pic_state *pic, void *ptr, size_t size, size_t count, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
char *bptr = ptr; char *bptr = ptr;
long nbytes; long nbytes;
int c; int c;
@ -294,7 +342,7 @@ pic_fread(pic_state *pic, void *ptr, size_t size, size_t count, pic_value port)
size_t size_t
pic_fwrite(pic_state *pic, const void *ptr, size_t size, size_t count, pic_value port) pic_fwrite(pic_state *pic, const void *ptr, size_t size, size_t count, pic_value port)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
const char *bptr = ptr; const char *bptr = ptr;
long nbytes; long nbytes;
@ -317,7 +365,7 @@ pic_fwrite(pic_state *pic, const void *ptr, size_t size, size_t count, pic_value
long long
pic_fseek(pic_state *pic, pic_value port, long offset, int whence) pic_fseek(pic_state *pic, pic_value port, long offset, int whence)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
long s; long s;
pic_fflush(pic, port); pic_fflush(pic, port);
@ -421,7 +469,7 @@ string_close(pic_state *pic, void *cookie)
return 0; return 0;
} }
pic_value static pic_value
pic_fmemopen(pic_state *pic, const char *data, int size, const char *mode) pic_fmemopen(pic_state *pic, const char *data, int size, const char *mode)
{ {
static const pic_port_type string_rd = { string_read, 0, string_seek, string_close }; static const pic_port_type string_rd = { string_read, 0, string_seek, string_close };
@ -442,10 +490,10 @@ pic_fmemopen(pic_state *pic, const char *data, int size, const char *mode)
} }
} }
int static int
pic_fgetbuf(pic_state *pic, pic_value port, const char **buf, int *len) pic_fgetbuf(pic_state *pic, pic_value port, const char **buf, int *len)
{ {
struct file *fp = &port_ptr(pic, port)->file; struct port *fp = pic_data(pic, port);
xbuf_t *s; xbuf_t *s;
pic_fflush(pic, port); pic_fflush(pic, port);
@ -462,10 +510,10 @@ pic_fgetbuf(pic_state *pic, pic_value port, const char **buf, int *len)
bool bool
pic_port_p(pic_state *pic, pic_value obj, const pic_port_type *type) pic_port_p(pic_state *pic, pic_value obj, const pic_port_type *type)
{ {
if (pic_type(pic, obj) != PIC_TYPE_PORT) { if (! pic_data_p(pic, obj, &port_type)) {
return false; return false;
} }
return type == NULL || port_ptr(pic, obj)->file.vtable == type; return type == NULL || port_ptr(pic, obj)->vtable == type;
} }
static pic_value static pic_value
@ -475,7 +523,7 @@ pic_port_input_port_p(pic_state *pic)
pic_get_args(pic, "o", &v); pic_get_args(pic, "o", &v);
if (pic_port_p(pic, v, NULL) && (port_ptr(pic, v)->file.flag & FILE_READ) != 0) { if (pic_port_p(pic, v, NULL) && (port_ptr(pic, v)->flag & FILE_READ) != 0) {
return pic_true_value(pic); return pic_true_value(pic);
} else { } else {
return pic_false_value(pic); return pic_false_value(pic);
@ -489,7 +537,7 @@ pic_port_output_port_p(pic_state *pic)
pic_get_args(pic, "o", &v); pic_get_args(pic, "o", &v);
if (pic_port_p(pic, v, NULL) && (port_ptr(pic, v)->file.flag & FILE_WRITE) != 0) { if (pic_port_p(pic, v, NULL) && (port_ptr(pic, v)->flag & FILE_WRITE) != 0) {
return pic_true_value(pic); return pic_true_value(pic);
} }
else { else {
@ -532,7 +580,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(pic, port_ptr(pic, port)->file.flag != 0); return pic_bool_value(pic, port_ptr(pic, port)->flag != 0);
} }
static pic_value static pic_value
@ -548,7 +596,7 @@ pic_port_close_port(pic_state *pic)
} }
#define assert_port_profile(port, flags, caller) do { \ #define assert_port_profile(port, flags, caller) do { \
int flag = port_ptr(pic, port)->file.flag; \ int flag = port_ptr(pic, port)->flag; \
if ((flag & (flags)) != (flags)) { \ if ((flag & (flags)) != (flags)) { \
switch (flags) { \ switch (flags) { \
case FILE_WRITE: \ case FILE_WRITE: \
@ -751,3 +799,5 @@ pic_init_port(pic_state *pic)
pic_defun(pic, "open-output-bytevector", pic_port_open_output_bytevector); pic_defun(pic, "open-output-bytevector", pic_port_open_output_bytevector);
pic_defun(pic, "get-output-bytevector", pic_port_get_output_bytevector); pic_defun(pic, "get-output-bytevector", pic_port_get_output_bytevector);
} }
#endif

2
lib/ext/read.c
View File

@ -775,7 +775,7 @@ pic_read_read(pic_state *pic)
{ {
pic_value port = pic_stdin(pic); pic_value port = pic_stdin(pic);
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|o", &port);
return read_value(pic, port); return read_value(pic, port);
} }

10
lib/ext/write.c
View File

@ -338,8 +338,6 @@ typename(pic_state *pic, pic_value obj)
return "vector"; return "vector";
case PIC_TYPE_BLOB: case PIC_TYPE_BLOB:
return "bytevector"; return "bytevector";
case PIC_TYPE_PORT:
return "port";
case PIC_TYPE_FRAME: case PIC_TYPE_FRAME:
return "frame"; return "frame";
case PIC_TYPE_IREP: case PIC_TYPE_IREP:
@ -452,7 +450,7 @@ pic_write_write(pic_state *pic)
{ {
pic_value v, port = pic_stdout(pic); pic_value v, port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port); pic_get_args(pic, "o|o", &v, &port);
write_value(pic, v, port, WRITE_MODE, OP_WRITE); write_value(pic, v, port, WRITE_MODE, OP_WRITE);
return pic_undef_value(pic); return pic_undef_value(pic);
} }
@ -462,7 +460,7 @@ pic_write_write_simple(pic_state *pic)
{ {
pic_value v, port = pic_stdout(pic); pic_value v, port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port); pic_get_args(pic, "o|o", &v, &port);
write_value(pic, v, port, WRITE_MODE, OP_WRITE_SIMPLE); write_value(pic, v, port, WRITE_MODE, OP_WRITE_SIMPLE);
return pic_undef_value(pic); return pic_undef_value(pic);
} }
@ -472,7 +470,7 @@ pic_write_write_shared(pic_state *pic)
{ {
pic_value v, port = pic_stdout(pic); pic_value v, port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port); pic_get_args(pic, "o|o", &v, &port);
write_value(pic, v, port, WRITE_MODE, OP_WRITE_SHARED); write_value(pic, v, port, WRITE_MODE, OP_WRITE_SHARED);
return pic_undef_value(pic); return pic_undef_value(pic);
} }
@ -482,7 +480,7 @@ pic_write_display(pic_state *pic)
{ {
pic_value v, port = pic_stdout(pic); pic_value v, port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port); pic_get_args(pic, "o|o", &v, &port);
write_value(pic, v, port, DISPLAY_MODE, OP_WRITE); write_value(pic, v, port, DISPLAY_MODE, OP_WRITE);
return pic_undef_value(pic); return pic_undef_value(pic);
} }

9
lib/gc.c
View File

@ -26,7 +26,6 @@ struct object {
struct record rec; struct record rec;
struct proc proc; struct proc proc;
struct frame frame; struct frame frame;
struct port port;
struct irep irep; struct irep irep;
} u; } u;
}; };
@ -266,9 +265,6 @@ gc_mark_object(pic_state *pic, struct object *obj)
} }
break; break;
} }
case PIC_TYPE_PORT: {
break;
}
case PIC_TYPE_STRING: { case PIC_TYPE_STRING: {
break; break;
} }
@ -424,10 +420,6 @@ gc_finalize_object(pic_state *pic, struct object *obj)
pic_free(pic, irep->irep); pic_free(pic, irep->irep);
break; break;
} }
case PIC_TYPE_PORT: {
pic_fclose(pic, obj_value(pic, obj)); /* FIXME */
break;
}
case PIC_TYPE_FRAME: { case PIC_TYPE_FRAME: {
pic_free(pic, obj->u.frame.regs); pic_free(pic, obj->u.frame.regs);
break; break;
@ -456,7 +448,6 @@ type2size(int type)
case PIC_TYPE_SYMBOL: return sizeof(struct symbol); case PIC_TYPE_SYMBOL: return sizeof(struct symbol);
case PIC_TYPE_ATTR: return sizeof(struct attr); case PIC_TYPE_ATTR: return sizeof(struct attr);
case PIC_TYPE_IREP: return sizeof(struct irep); case PIC_TYPE_IREP: return sizeof(struct irep);
case PIC_TYPE_PORT: return sizeof(struct port);
case PIC_TYPE_PAIR: return sizeof(struct pair); case PIC_TYPE_PAIR: return sizeof(struct pair);
case PIC_TYPE_FRAME: return sizeof(struct frame); case PIC_TYPE_FRAME: return sizeof(struct frame);
case PIC_TYPE_RECORD: return sizeof(struct record); case PIC_TYPE_RECORD: return sizeof(struct record);

1
lib/include/picconf.h
View File

@ -14,6 +14,7 @@
*/ */
/* #define PIC_USE_CALLCC 1 */ /* #define PIC_USE_CALLCC 1 */
/* #define PIC_USE_PORT 1 */
/* #define PIC_USE_READ 1 */ /* #define PIC_USE_READ 1 */
/* #define PIC_USE_WRITE 1 */ /* #define PIC_USE_WRITE 1 */
/* #define PIC_USE_EVAL 1 */ /* #define PIC_USE_EVAL 1 */

49
lib/include/picrin.h
View File

@ -243,55 +243,6 @@ pic_value pic_apply(pic_state *, pic_value proc, int n, pic_value *argv);
pic_value pic_applyk(pic_state *, pic_value proc, int n, pic_value *argv); pic_value pic_applyk(pic_state *, pic_value proc, int n, pic_value *argv);
/*
* port
*/
typedef struct {
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 *);
} pic_port_type;
#define PIC_SEEK_CUR 0
#define PIC_SEEK_END 1
#define PIC_SEEK_SET 2
#define PIC_IONBF 0
#define PIC_IOLBF 1
#define PIC_IOFBF 2
#define pic_stdin(pic) pic_funcall(pic, "current-input-port", 0)
#define pic_stdout(pic) pic_funcall(pic, "current-output-port", 0)
#define pic_stderr(pic) pic_funcall(pic, "current-error-port", 0)
bool pic_eof_p(pic_state *, pic_value);
pic_value pic_eof_object(pic_state *);
bool pic_port_p(pic_state *, pic_value, const pic_port_type *type);
/* basic methods */
pic_value pic_funopen(pic_state *, void *cookie, const pic_port_type *type);
size_t pic_fread(pic_state *, void *ptr, size_t size, size_t count, pic_value port);
size_t pic_fwrite(pic_state *, const void *ptr, size_t size, size_t count, pic_value port);
long pic_fseek(pic_state *, pic_value port, long offset, int whence);
int pic_fclose(pic_state *, pic_value port);
/* error handling */
void pic_clearerr(pic_state *, pic_value port);
int pic_feof(pic_state *, pic_value port);
int pic_ferror(pic_state *, pic_value port);
/* character I/O */
int pic_fputc(pic_state *, int c, pic_value port);
int pic_fgetc(pic_state *, pic_value port);
int pic_fputs(pic_state *, const char *s, pic_value port);
char *pic_fgets(pic_state *, char *s, int size, pic_value port);
int pic_ungetc(pic_state *, int c, pic_value port);
int pic_fflush(pic_state *, pic_value port);
int pic_setvbuf(pic_state *, pic_value port, char *buf, int mode, size_t size);
/* formatted output */
int pic_printf(pic_state *, const char *fmt, ...);
int pic_fprintf(pic_state *, pic_value port, const char *fmt, ...);
int pic_vfprintf(pic_state *, pic_value port, const char *fmt, va_list ap);
/* /*
* core language features * core language features
*/ */

50
lib/include/picrin/extra.h
View File

@ -14,6 +14,56 @@ void *pic_default_allocf(void *, void *, size_t);
void pic_default_panicf(pic_state *, const char *, int, pic_value *); void pic_default_panicf(pic_state *, const char *, int, pic_value *);
#endif #endif
#if PIC_USE_PORT
typedef struct {
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 *);
} pic_port_type;
#ifndef EOF
# define EOF (-1)
#endif
#define PIC_SEEK_CUR 0
#define PIC_SEEK_END 1
#define PIC_SEEK_SET 2
#define PIC_IONBF 0
#define PIC_IOLBF 1
#define PIC_IOFBF 2
#define pic_stdin(pic) pic_funcall(pic, "current-input-port", 0)
#define pic_stdout(pic) pic_funcall(pic, "current-output-port", 0)
#define pic_stderr(pic) pic_funcall(pic, "current-error-port", 0)
bool pic_eof_p(pic_state *, pic_value);
pic_value pic_eof_object(pic_state *);
bool pic_port_p(pic_state *, pic_value, const pic_port_type *type);
/* basic methods */
pic_value pic_funopen(pic_state *, void *cookie, const pic_port_type *type);
size_t pic_fread(pic_state *, void *ptr, size_t size, size_t count, pic_value port);
size_t pic_fwrite(pic_state *, const void *ptr, size_t size, size_t count, pic_value port);
long pic_fseek(pic_state *, pic_value port, long offset, int whence);
int pic_fclose(pic_state *, pic_value port);
/* error handling */
void pic_clearerr(pic_state *, pic_value port);
int pic_feof(pic_state *, pic_value port);
int pic_ferror(pic_state *, pic_value port);
/* character I/O */
int pic_fputc(pic_state *, int c, pic_value port);
int pic_fgetc(pic_state *, pic_value port);
int pic_fputs(pic_state *, const char *s, pic_value port);
char *pic_fgets(pic_state *, char *s, int size, pic_value port);
int pic_ungetc(pic_state *, int c, pic_value port);
int pic_fflush(pic_state *, pic_value port);
int pic_setvbuf(pic_state *, pic_value port, char *buf, int mode, size_t size);
/* formatted output */
int pic_printf(pic_state *, const char *fmt, ...);
int pic_fprintf(pic_state *, pic_value port, const char *fmt, ...);
int pic_vfprintf(pic_state *, pic_value port, const char *fmt, va_list ap);
#endif
#if PIC_USE_FILE #if PIC_USE_FILE
pic_value pic_fopen(pic_state *, FILE *, const char *mode); pic_value pic_fopen(pic_state *, FILE *, const char *mode);
#endif #endif

13
lib/include/picrin/setup.h
View File

@ -8,6 +8,10 @@
# define PIC_USE_LIBC 1 # define PIC_USE_LIBC 1
#endif #endif
#ifndef PIC_USE_PORT
# define PIC_USE_PORT 1
#endif
#ifndef PIC_USE_CALLCC #ifndef PIC_USE_CALLCC
# define PIC_USE_CALLCC 1 # define PIC_USE_CALLCC 1
#endif #endif
@ -32,6 +36,15 @@
# define PIC_USE_ERROR 1 # define PIC_USE_ERROR 1
#endif #endif
#if !PIC_USE_PORT && PIC_USE_READ
# error PIC_USE_READ requires PIC_USE_PORT
#endif
#if !PIC_USE_PORT && PIC_USE_WRITE
# error PIC_USE_WRITE requires PIC_USE_PORT
#endif
#if !PIC_USE_PORT && PIC_USE_FILE
# error PIC_USE_FILE requires PIC_USE_PORT
#endif
#if !PIC_USE_LIBC && PIC_USE_FILE #if !PIC_USE_LIBC && PIC_USE_FILE
# error PIC_USE_FILE requires PIC_USE_LIBC # error PIC_USE_FILE requires PIC_USE_LIBC
#endif #endif

28
lib/object.h
View File

@ -128,31 +128,6 @@ struct proc {
struct frame *env; struct frame *env;
}; };
enum {
FILE_READ = 01,
FILE_WRITE = 02,
FILE_UNBUF = 04,
FILE_EOF = 010,
FILE_ERR = 020,
FILE_LNBUF = 040,
FILE_SETBUF = 0100
};
struct port {
OBJECT_HEADER
struct file {
/* buffer */
char buf[1]; /* fallback buffer */
long cnt; /* characters left */
char *ptr; /* next character position */
char *base; /* location of the buffer */
/* operators */
void *cookie;
const pic_port_type *vtable;
int flag; /* mode of the file access */
} file;
};
#define TYPENAME_int "integer" #define TYPENAME_int "integer"
#define TYPENAME_blob "bytevector" #define TYPENAME_blob "bytevector"
#define TYPENAME_char "character" #define TYPENAME_char "character"
@ -199,7 +174,6 @@ obj_value(pic_state *pic, void *ptr)
} }
#define pic_data_p(pic,o) (pic_data_p(pic,o,NULL)) #define pic_data_p(pic,o) (pic_data_p(pic,o,NULL))
#define pic_port_p(pic,o) (pic_port_p(pic,o,NULL))
DEFPTR(sym, struct symbol) DEFPTR(sym, struct symbol)
DEFPTR(str, struct string) DEFPTR(str, struct string)
DEFPTR(blob, struct blob) DEFPTR(blob, struct blob)
@ -209,11 +183,9 @@ DEFPTR(dict, struct dict)
DEFPTR(attr, struct attr) DEFPTR(attr, struct attr)
DEFPTR(data, struct data) DEFPTR(data, struct data)
DEFPTR(proc, struct proc) DEFPTR(proc, struct proc)
DEFPTR(port, struct port)
DEFPTR(rec, struct record) DEFPTR(rec, struct record)
DEFPTR(irep, struct irep) DEFPTR(irep, struct irep)
#undef pic_data_p #undef pic_data_p
#undef pic_port_p
struct object *pic_obj_alloc(pic_state *, int type); struct object *pic_obj_alloc(pic_state *, int type);
struct object *pic_obj_alloc_unsafe(pic_state *, int type); struct object *pic_obj_alloc_unsafe(pic_state *, int type);

4
lib/proc.c
View File

@ -249,7 +249,6 @@ arg_error(pic_state *pic, int actual, bool varg, int expected)
* v pic_value * vector * v pic_value * vector
* s pic_value * string * s pic_value * string
* l pic_value * lambda * l pic_value * lambda
* p pic_value * port
* d pic_value * dictionary * d pic_value * dictionary
* r pic_value * record * r pic_value * record
* *
@ -421,9 +420,6 @@ pic_get_args(pic_state *pic, const char *format, ...)
OBJ_CASE('l', proc) OBJ_CASE('l', proc)
OBJ_CASE('v', vec) OBJ_CASE('v', vec)
OBJ_CASE('d', dict) OBJ_CASE('d', dict)
#define pic_port_p(pic,v) pic_port_p(pic,v,NULL)
OBJ_CASE('p', port)
#undef pic_port_p
OBJ_CASE('r', rec) OBJ_CASE('r', rec)
default: default:

183
lib/serialize.c
View File

@ -6,72 +6,71 @@
#include "value.h" #include "value.h"
#include "object.h" #include "object.h"
static void static void dump1(unsigned char c, unsigned char *buf, int *len) {
dump1(pic_state *pic, unsigned char c, pic_value port) if (buf) {
{ buf[*len] = c;
pic_fputc(pic, c, port); }
*len = *len + 1;
} }
static void static void dump4(unsigned long n, unsigned char *buf, int *len) {
dump4(pic_state *pic, unsigned long n, pic_value port) assert(sizeof(long) * CHAR_BIT <= 32 || n <= 0xfffffffful);
{
assert(sizeof(long) * CHAR_BIT <= 32 || n < (1ul << 32));
dump1(pic, (n & 0xff), port); dump1((n & 0xff), buf, len);
dump1(pic, (n & 0xff00) >> 8, port); dump1((n & 0xff00) >> 8, buf, len);
dump1(pic, (n & 0xff0000) >> 16, port); dump1((n & 0xff0000) >> 16, buf, len);
dump1(pic, (n & 0xff000000) >> 24, port); dump1((n & 0xff000000) >> 24, buf, len);
} }
static void dump_obj(pic_state *pic, pic_value obj, pic_value port); static void dump_obj(pic_state *pic, pic_value obj, unsigned char *buf, int *len);
#define IREP_FLAGS_MASK (IREP_VARG) #define IREP_FLAGS_MASK (IREP_VARG)
static void static void
dump_irep(pic_state *pic, struct irep *irep, pic_value port) dump_irep(pic_state *pic, struct irep *irep, unsigned char *buf, int *len)
{ {
size_t i; size_t i;
dump1(pic, irep->argc, port); dump1(irep->argc, buf, len);
dump1(pic, irep->flags & IREP_FLAGS_MASK, port); dump1(irep->flags & IREP_FLAGS_MASK, buf, len);
dump1(pic, irep->frame_size, port); dump1(irep->frame_size, buf, len);
dump1(pic, irep->irepc, port); dump1(irep->irepc, buf, len);
dump1(pic, irep->objc, port); dump1(irep->objc, buf, len);
dump4(pic, irep->codec, port); dump4(irep->codec, buf, len);
for (i = 0; i < irep->objc; ++i) { for (i = 0; i < irep->objc; ++i) {
dump_obj(pic, irep->obj[i], port); dump_obj(pic, irep->obj[i], buf, len);
} }
for (i = 0; i < irep->codec; ++i) { for (i = 0; i < irep->codec; ++i) {
dump1(pic, irep->code[i], port); dump1(irep->code[i], buf, len);
} }
for (i = 0; i < irep->irepc; ++i) { for (i = 0; i < irep->irepc; ++i) {
dump_irep(pic, irep->irep[i], port); dump_irep(pic, irep->irep[i], buf, len);
} }
} }
static void static void
dump_obj(pic_state *pic, pic_value obj, pic_value port) dump_obj(pic_state *pic, pic_value obj, unsigned char *buf, int *len)
{ {
if (pic_int_p(pic, obj)) { if (pic_int_p(pic, obj)) {
dump1(pic, 0x00, port); dump1(0x00, buf, len);
dump4(pic, pic_int(pic, obj), port); dump4(pic_int(pic, obj), buf, len);
} else if (pic_str_p(pic, obj)) { } else if (pic_str_p(pic, obj)) {
int len, i; int l, i;
const char *str = pic_str(pic, obj, &len); const char *str = pic_str(pic, obj, &l);
dump1(pic, 0x01, port); dump1(0x01, buf, len);
dump4(pic, len, port); dump4(l, buf, len);
for (i = 0; i < len; ++i) { for (i = 0; i < l; ++i) {
dump1(pic, str[i], port); dump1(str[i], buf, len);
} }
dump1(pic, 0, port); dump1(0, buf, len);
} else if (pic_sym_p(pic, obj)) { } else if (pic_sym_p(pic, obj)) {
int len, i; int l, i;
const char *str = pic_str(pic, pic_sym_name(pic, obj), &len); const char *str = pic_str(pic, pic_sym_name(pic, obj), &l);
dump1(pic, 0x02, port); dump1(0x02, buf, len);
dump4(pic, len, port); dump4(l, buf, len);
for (i = 0; i < len; ++i) { for (i = 0; i < l; ++i) {
dump1(pic, str[i], port); dump1(str[i], buf, len);
} }
dump1(pic, 0, port); dump1(0, buf, len);
} else if (pic_proc_p(pic, obj)) { } else if (pic_proc_p(pic, obj)) {
if (pic_proc_func_p(pic, obj)) { if (pic_proc_func_p(pic, obj)) {
pic_error(pic, "dump: c function procedure serialization unsupported", 1, obj); pic_error(pic, "dump: c function procedure serialization unsupported", 1, obj);
@ -79,11 +78,11 @@ dump_obj(pic_state *pic, pic_value obj, pic_value port)
if (proc_ptr(pic, obj)->env) { if (proc_ptr(pic, obj)->env) {
pic_error(pic, "dump: local procedure serialization unsupported", 1, obj); pic_error(pic, "dump: local procedure serialization unsupported", 1, obj);
} }
dump1(pic, 0x03, port); dump1(0x03, buf, len);
dump_irep(pic, proc_ptr(pic, obj)->u.irep, port); dump_irep(pic, proc_ptr(pic, obj)->u.irep, buf, len);
} else if (pic_char_p(pic, obj)) { } else if (pic_char_p(pic, obj)) {
dump1(pic, 0x04, port); dump1(0x04, buf, len);
dump1(pic, pic_char(pic, obj), port); dump1(pic_char(pic, obj), buf, len);
} else { } else {
pic_error(pic, "dump: unsupported object", 1, obj); pic_error(pic, "dump: unsupported object", 1, obj);
} }
@ -92,34 +91,38 @@ dump_obj(pic_state *pic, pic_value obj, pic_value port)
pic_value pic_value
pic_serialize(pic_state *pic, pic_value obj) pic_serialize(pic_state *pic, pic_value obj)
{ {
pic_value port = pic_funcall(pic, "open-output-bytevector", 0); int len = 0;
pic_value blob; pic_value blob;
dump_obj(pic, obj, port); dump_obj(pic, obj, NULL, &len);
blob = pic_funcall(pic, "get-output-bytevector", 1, port); blob = pic_blob_value(pic, NULL, len);
pic_fclose(pic, port); len = 0;
dump_obj(pic, obj, pic_blob(pic, blob, NULL), &len);
return blob; return blob;
} }
static unsigned char static unsigned char load1(const unsigned char *buf, int *len) {
load1(pic_state *pic, pic_value port) char c = buf[*len];
{ *len = *len + 1;
return pic_fgetc(pic, port); return c;
} }
static unsigned long static unsigned long load4(const unsigned char *buf, int *len) {
load4(pic_state *pic, pic_value port) unsigned long x = load1(buf, len);
{ x += load1(buf, len) << 8;
unsigned long x = load1(pic, port); x += load1(buf, len) << 16;
x += load1(pic, port) << 8; x += load1(buf, len) << 24;
x += load1(pic, port) << 16;
x += load1(pic, port) << 24;
return x; return x;
} }
static pic_value load_obj(pic_state *pic, pic_value port); static void loadn(unsigned char *dst, size_t size, const unsigned char *buf, int *len) {
memcpy(dst, buf + *len, size);
*len = *len + size;
}
static pic_value load_obj(pic_state *pic, const unsigned char *buf, int *len);
static struct irep * static struct irep *
load_irep(pic_state *pic, pic_value port) load_irep(pic_state *pic, const unsigned char *buf, int *len)
{ {
unsigned char argc, flags, frame_size, irepc, objc; unsigned char argc, flags, frame_size, irepc, objc;
size_t codec, i; size_t codec, i;
@ -128,21 +131,21 @@ load_irep(pic_state *pic, pic_value port)
struct irep **irep, *ir; struct irep **irep, *ir;
size_t ai = pic_enter(pic); size_t ai = pic_enter(pic);
argc = load1(pic, port); argc = load1(buf, len);
flags = load1(pic, port); flags = load1(buf, len);
frame_size = load1(pic, port); frame_size = load1(buf, len);
irepc = load1(pic, port); irepc = load1(buf, len);
objc = load1(pic, port); objc = load1(buf, len);
codec = load4(pic, port); codec = load4(buf, len);
obj = pic_malloc(pic, sizeof(pic_value) * objc); obj = pic_malloc(pic, sizeof(pic_value) * objc);
for (i = 0; i < objc; ++i) { for (i = 0; i < objc; ++i) {
obj[i] = load_obj(pic, port); obj[i] = load_obj(pic, buf, len);
} }
code = pic_malloc(pic, codec); /* TODO */ code = pic_malloc(pic, codec); /* TODO */
pic_fread(pic, code, codec, 1, port); loadn(code, codec, buf, len);
irep = pic_malloc(pic, sizeof(struct irep *) * irepc); irep = pic_malloc(pic, sizeof(struct irep *) * irepc);
for (i = 0; i < irepc; ++i) { for (i = 0; i < irepc; ++i) {
irep[i] = load_irep(pic, port); irep[i] = load_irep(pic, buf, len);
} }
ir = (struct irep *) pic_obj_alloc(pic, PIC_TYPE_IREP); ir = (struct irep *) pic_obj_alloc(pic, PIC_TYPE_IREP);
ir->argc = argc; ir->argc = argc;
@ -160,39 +163,39 @@ load_irep(pic_state *pic, pic_value port)
} }
static pic_value static pic_value
load_obj(pic_state *pic, pic_value port) load_obj(pic_state *pic, const unsigned char *buf, int *len)
{ {
int type, len; int type, l;
pic_value obj; pic_value obj;
char *buf, c; char *dat, c;
struct irep *irep; struct irep *irep;
struct proc *proc; struct proc *proc;
type = load1(pic, port); type = load1(buf, len);
switch (type) { switch (type) {
case 0x00: case 0x00:
return pic_int_value(pic, load4(pic, port)); return pic_int_value(pic, load4(buf, len));
case 0x01: case 0x01:
len = load4(pic, port); l = load4(buf, len);
buf = pic_malloc(pic, len + 1); /* TODO */ dat = pic_malloc(pic, l + 1); /* TODO */
pic_fread(pic, buf, len + 1, 1, port); loadn((unsigned char *) dat, l + 1, buf, len);
obj = pic_str_value(pic, buf, len); obj = pic_str_value(pic, dat, l);
pic_free(pic, buf); pic_free(pic, dat);
return obj; return obj;
case 0x02: case 0x02:
len = load4(pic, port); l = load4(buf, len);
buf = pic_malloc(pic, len + 1); /* TODO */ dat = pic_malloc(pic, l + 1); /* TODO */
pic_fread(pic, buf, len + 1, 1, port); loadn((unsigned char *) dat, l + 1, buf, len);
obj = pic_intern_str(pic, buf, len); obj = pic_intern_str(pic, dat, l);
pic_free(pic, buf); pic_free(pic, dat);
return obj; return obj;
case 0x03: case 0x03:
irep = load_irep(pic, port); irep = load_irep(pic, buf, len);
proc = (struct proc *)pic_obj_alloc(pic, PIC_TYPE_PROC_IREP); proc = (struct proc *)pic_obj_alloc(pic, PIC_TYPE_PROC_IREP);
proc->u.irep = irep; proc->u.irep = irep;
proc->env = NULL; proc->env = NULL;
return obj_value(pic, proc); return obj_value(pic, proc);
case 0x04: case 0x04:
c = load1(pic, port); c = load1(buf, len);
return pic_char_value(pic, c); return pic_char_value(pic, c);
default: default:
pic_error(pic, "load: unsupported object", 1, pic_int_value(pic, type)); pic_error(pic, "load: unsupported object", 1, pic_int_value(pic, type));
@ -202,8 +205,6 @@ load_obj(pic_state *pic, pic_value port)
pic_value pic_value
pic_deserialize(pic_state *pic, pic_value blob) pic_deserialize(pic_state *pic, pic_value blob)
{ {
pic_value port = pic_funcall(pic, "open-input-bytevector", 1, blob); int len = 0;
pic_value obj = load_obj(pic, port); return load_obj(pic, pic_blob(pic, blob, NULL), &len);
pic_fclose(pic, port);
return obj;
} }

2
lib/value.h
View File

@ -30,7 +30,6 @@ enum {
PIC_TYPE_DICT = 22, PIC_TYPE_DICT = 22,
PIC_TYPE_RECORD = 23, PIC_TYPE_RECORD = 23,
PIC_TYPE_ATTR = 24, PIC_TYPE_ATTR = 24,
PIC_TYPE_PORT = 25,
PIC_TYPE_IREP = 27, PIC_TYPE_IREP = 27,
PIC_TYPE_FRAME = 28, PIC_TYPE_FRAME = 28,
PIC_TYPE_PROC_FUNC = 29, PIC_TYPE_PROC_FUNC = 29,
@ -243,7 +242,6 @@ DEFPRED(proc_func, PIC_TYPE_PROC_FUNC)
DEFPRED(proc_irep, PIC_TYPE_PROC_IREP) DEFPRED(proc_irep, PIC_TYPE_PROC_IREP)
DEFPRED(irep, PIC_TYPE_IREP) DEFPRED(irep, PIC_TYPE_IREP)
DEFPRED(data, PIC_TYPE_DATA) DEFPRED(data, PIC_TYPE_DATA)
DEFPRED(port, PIC_TYPE_PORT)
#undef DEFPRED #undef DEFPRED