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\
number.c\
pair.c\
port.c\
proc.c\
record.c\
serialize.c\
@ -20,6 +19,7 @@ LIBPICRIN_SRCS = \
vector.c\
ext/cont.c\
ext/eval.c\
ext/port.c\
ext/read.c\
ext/write.c\
ext/file.c\

1
lib/ext/file.c
View File

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

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

@ -3,47 +3,95 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"
#include "picrin/extra.h"
#ifndef EOF
# define EOF (-1)
#endif
#if PIC_USE_PORT
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_funopen(pic_state *pic, void *cookie, const pic_port_type *type)
{
struct port *port;
port = (struct port *)pic_obj_alloc(pic, PIC_TYPE_PORT);
port->file.cnt = 0;
port->file.base = NULL;
port->file.flag = type->read ? FILE_READ : FILE_WRITE;
port->file.cookie = cookie;
port->file.vtable = type;
port = pic_malloc(pic, sizeof(*port));
port->cnt = 0;
port->base = NULL;
port->flag = type->read ? FILE_READ : FILE_WRITE;
port->cookie = cookie;
port->vtable = type;
return obj_value(pic, port);
return pic_data_value(pic, port, &port_type);
}
int
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;
pic_fflush(pic, port);
fp->flag = 0;
if (fp->base != fp->buf && (fp->flag & FILE_SETBUF) == 0)
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
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);
}
@ -51,7 +99,7 @@ pic_clearerr(pic_state *pic, pic_value port)
int
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;
}
@ -59,7 +107,7 @@ pic_feof(pic_state *pic, pic_value port)
int
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;
}
@ -67,7 +115,7 @@ pic_ferror(pic_state *pic, pic_value port)
int
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);
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) {
return 0;
}
if (size != PIC_BUFSIZ) {
if (size < PIC_BUFSIZ) {
return EOF;
}
fp->base = buf;
@ -88,7 +136,7 @@ pic_setvbuf(pic_state *pic, pic_value port, char *buf, int mode, size_t size)
}
static int
fillbuf(pic_state *pic, struct file *fp)
fillbuf(pic_state *pic, struct port *fp)
{
int bufsize;
@ -124,7 +172,7 @@ fillbuf(pic_state *pic, struct file *fp)
}
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;
char c = x;
@ -179,7 +227,7 @@ flushbuf(pic_state *pic, int x, struct file *fp)
int
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;
retval = 0;
@ -203,7 +251,7 @@ pic_fflush(pic_state *pic, pic_value port)
int
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);
}
@ -211,7 +259,7 @@ pic_fputc(pic_state *pic, int x, pic_value port)
int
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);
}
@ -219,7 +267,7 @@ pic_fgetc(pic_state *pic, pic_value port)
int
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;
while(*ptr != '\0') {
@ -233,7 +281,7 @@ pic_fputs(pic_state *pic, const char *s, pic_value port)
char *
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;
char *buf;
@ -255,7 +303,7 @@ pic_fgets(pic_state *pic, char *s, int size, pic_value port)
int
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;
if (c == EOF || fp->base == fp->ptr) {
@ -268,7 +316,7 @@ pic_ungetc(pic_state *pic, int c, pic_value port)
size_t
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;
long nbytes;
int c;
@ -294,7 +342,7 @@ pic_fread(pic_state *pic, void *ptr, size_t size, size_t count, pic_value port)
size_t
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;
long nbytes;
@ -317,7 +365,7 @@ pic_fwrite(pic_state *pic, const void *ptr, size_t size, size_t count, pic_value
long
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;
pic_fflush(pic, port);
@ -421,7 +469,7 @@ string_close(pic_state *pic, void *cookie)
return 0;
}
pic_value
static pic_value
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 };
@ -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)
{
struct file *fp = &port_ptr(pic, port)->file;
struct port *fp = pic_data(pic, port);
xbuf_t *s;
pic_fflush(pic, port);
@ -462,10 +510,10 @@ pic_fgetbuf(pic_state *pic, pic_value port, const char **buf, int *len)
bool
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 type == NULL || port_ptr(pic, obj)->file.vtable == type;
return type == NULL || port_ptr(pic, obj)->vtable == type;
}
static pic_value
@ -475,7 +523,7 @@ pic_port_input_port_p(pic_state *pic)
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);
} else {
return pic_false_value(pic);
@ -489,7 +537,7 @@ pic_port_output_port_p(pic_state *pic)
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);
}
else {
@ -532,7 +580,7 @@ pic_port_port_open_p(pic_state *pic)
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
@ -548,7 +596,7 @@ pic_port_close_port(pic_state *pic)
}
#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)) { \
switch (flags) { \
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, "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_get_args(pic, "|p", &port);
pic_get_args(pic, "|o", &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";
case PIC_TYPE_BLOB:
return "bytevector";
case PIC_TYPE_PORT:
return "port";
case PIC_TYPE_FRAME:
return "frame";
case PIC_TYPE_IREP:
@ -452,7 +450,7 @@ pic_write_write(pic_state *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);
return pic_undef_value(pic);
}
@ -462,7 +460,7 @@ pic_write_write_simple(pic_state *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);
return pic_undef_value(pic);
}
@ -472,7 +470,7 @@ pic_write_write_shared(pic_state *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);
return pic_undef_value(pic);
}
@ -482,7 +480,7 @@ pic_write_display(pic_state *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);
return pic_undef_value(pic);
}

9
lib/gc.c
View File

@ -26,7 +26,6 @@ struct object {
struct record rec;
struct proc proc;
struct frame frame;
struct port port;
struct irep irep;
} u;
};
@ -266,9 +265,6 @@ gc_mark_object(pic_state *pic, struct object *obj)
}
break;
}
case PIC_TYPE_PORT: {
break;
}
case PIC_TYPE_STRING: {
break;
}
@ -424,10 +420,6 @@ gc_finalize_object(pic_state *pic, struct object *obj)
pic_free(pic, irep->irep);
break;
}
case PIC_TYPE_PORT: {
pic_fclose(pic, obj_value(pic, obj)); /* FIXME */
break;
}
case PIC_TYPE_FRAME: {
pic_free(pic, obj->u.frame.regs);
break;
@ -456,7 +448,6 @@ type2size(int type)
case PIC_TYPE_SYMBOL: return sizeof(struct symbol);
case PIC_TYPE_ATTR: return sizeof(struct attr);
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_FRAME: return sizeof(struct frame);
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_PORT 1 */
/* #define PIC_USE_READ 1 */
/* #define PIC_USE_WRITE 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);
/*
* 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
*/

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 *);
#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
pic_value pic_fopen(pic_state *, FILE *, const char *mode);
#endif

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

@ -8,6 +8,10 @@
# define PIC_USE_LIBC 1
#endif
#ifndef PIC_USE_PORT
# define PIC_USE_PORT 1
#endif
#ifndef PIC_USE_CALLCC
# define PIC_USE_CALLCC 1
#endif
@ -32,6 +36,15 @@
# define PIC_USE_ERROR 1
#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
# error PIC_USE_FILE requires PIC_USE_LIBC
#endif

28
lib/object.h
View File

@ -128,31 +128,6 @@ struct proc {
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_blob "bytevector"
#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_port_p(pic,o) (pic_port_p(pic,o,NULL))
DEFPTR(sym, struct symbol)
DEFPTR(str, struct string)
DEFPTR(blob, struct blob)
@ -209,11 +183,9 @@ DEFPTR(dict, struct dict)
DEFPTR(attr, struct attr)
DEFPTR(data, struct data)
DEFPTR(proc, struct proc)
DEFPTR(port, struct port)
DEFPTR(rec, struct record)
DEFPTR(irep, struct irep)
#undef pic_data_p
#undef pic_port_p
struct object *pic_obj_alloc(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
* s pic_value * string
* l pic_value * lambda
* p pic_value * port
* d pic_value * dictionary
* r pic_value * record
*
@ -421,9 +420,6 @@ pic_get_args(pic_state *pic, const char *format, ...)
OBJ_CASE('l', proc)
OBJ_CASE('v', vec)
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)
default:

183
lib/serialize.c
View File

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

2
lib/value.h
View File

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