diff --git a/lib/Makefile b/lib/Makefile index b56dcb94..eb4bf9ba 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -20,6 +20,7 @@ LIBPICRIN_SRCS = \ var.c\ vector.c\ weak.c\ + ext/serialize.c\ ext/eval.c\ ext/read.c\ ext/write.c\ diff --git a/lib/ext/main.c b/lib/ext/main.c index 8b6aa43b..fbc35302 100644 --- a/lib/ext/main.c +++ b/lib/ext/main.c @@ -35,18 +35,19 @@ main(int argc, char *argv[]) break; pic_void(pic, pic_funcall(pic, "eval", 1, e)); } - } else if (argc >= 2 && strcmp(argv[1], "-c") == 0) { /* compile */ - if (argc == 2) { + } else if (argc >= 3 && strcmp(argv[1], "-c") == 0) { /* compile */ + const char *name = argv[2]; + if (argc == 3) { port = pic_stdin(pic); } else { - FILE *file = fopen(argv[2], "r"); + FILE *file = fopen(argv[3], "r"); if (! file) { - fprintf(stderr, "could not open file %s\n", argv[2]); + fprintf(stderr, "could not open file %s\n", argv[3]); exit(1); } port = pic_fopen(pic, file, "r"); } - pic_printf(pic, "~s\n", pic_funcall(pic, "compile", 1, pic_funcall(pic, "read", 1, port))); + pic_serialize(pic, name, pic_assemble(pic, pic_funcall(pic, "compile", 1, pic_funcall(pic, "read", 1, port)))); } else { fprintf(stderr, "usage: mini-picrin [-c] [file]\n"); exit(1); diff --git a/lib/ext/serialize.c b/lib/ext/serialize.c new file mode 100644 index 00000000..23cf260e --- /dev/null +++ b/lib/ext/serialize.c @@ -0,0 +1,176 @@ +/** + * See Copyright Notice in picrin.h + */ + +#include "picrin.h" +#include "picrin/extra.h" +#include "../object.h" +#include "../state.h" + +static size_t offset = 0; + +#define DUMP(c) do { printf("0x%02x, ", c); if (++offset == 12) { puts(""); offset = 0; } } while (0) + +static void +dump1(pic_state *pic, unsigned char c) +{ + DUMP(c); +} + +static void +dump4(pic_state *pic, unsigned long n) +{ + assert(sizeof(long) * CHAR_BIT <= 32 || n < (1ul << 32)); + + dump1(pic, (n & 0xff)); + dump1(pic, (n & 0xff00) >> 8); + dump1(pic, (n & 0xff0000) >> 16); + dump1(pic, (n & 0xff000000) >> 24); +} + +static void +dump_obj(pic_state *pic, pic_value obj) +{ + if (pic_int_p(pic, obj)) { + dump1(pic, 0x00); + dump4(pic, pic_int(pic, obj)); + } else if (pic_str_p(pic, obj)) { + int len, i; + const char *str = pic_str(pic, obj, &len); + dump1(pic, 0x01); + dump4(pic, len); + for (i = 0; i < len; ++i) { + dump1(pic, str[i]); + } + dump1(pic, 0); + } 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); + dump4(pic, len); + for (i = 0; i < len; ++i) { + dump1(pic, str[i]); + } + dump1(pic, 0); + } else { + pic_error(pic, "dump: unsupported object", 1, obj); + } +} + +#define IREP_FLAGS_MASK (IREP_VARG) + +static void +dump_irep(pic_state *pic, struct irep *irep) +{ + size_t i; + dump1(pic, irep->argc); + dump1(pic, irep->flags & IREP_FLAGS_MASK); + dump1(pic, irep->frame_size); + dump1(pic, irep->irepc); + dump1(pic, irep->objc); + dump4(pic, irep->codec); + for (i = 0; i < irep->objc; ++i) { + dump_obj(pic, irep->obj[i]); + } + for (i = 0; i < irep->codec; ++i) { + dump1(pic, irep->code[i]); + } + for (i = 0; i < irep->irepc; ++i) { + dump_irep(pic, irep->irep[i]); + } +} + +void +pic_serialize(pic_state *pic, const char *name, pic_value irep) +{ + offset = 0; + printf("const unsigned char %s[] = {\n", name); + dump_irep(pic, irep_ptr(pic, irep)); + if (offset != 0) puts(""); + printf("};\n"); +} + +const unsigned char *bin; + +static unsigned char +load1(pic_state *pic) +{ + return *bin++; +} + +static unsigned long +load4(pic_state *pic) +{ + unsigned long x = bin[0] + (bin[1] << 8) + (bin[2] << 16) + (bin[3] << 24); + bin += 4; + return x; +} + +static pic_value +load_obj(pic_state *pic) +{ + int type, len; + pic_value obj; + type = load1(pic); + switch (type) { + case 0x00: + return pic_int_value(pic, load4(pic)); + case 0x01: + len = load4(pic); + obj = pic_str_value(pic, bin, -len); + bin += len + 1; + return obj; + case 0x02: + len = load4(pic); + obj = pic_str_value(pic, bin, -len); + obj = pic_intern(pic, obj); + bin += len + 1; + return obj; + default: + pic_error(pic, "load: unsupported object", 1, pic_int_value(pic, type)); + } +} + +static struct irep * +load_irep(pic_state *pic) +{ + unsigned char argc, flags, frame_size, irepc, objc; + size_t codec, i; + pic_value *obj; + const unsigned char *code; + struct irep **irep, *ir; + argc = load1(pic); + flags = load1(pic) | IREP_CODE_STATIC; + frame_size = load1(pic); + irepc = load1(pic); + objc = load1(pic); + codec = load4(pic); + obj = pic_malloc(pic, sizeof(pic_value) * objc); + for (i = 0; i < objc; ++i) { + obj[i] = load_obj(pic); + } + code = bin; + bin += codec; + irep = pic_malloc(pic, sizeof(struct irep *) * irepc); + for (i = 0; i < irepc; ++i) { + irep[i] = load_irep(pic); + } + ir = (struct irep *) pic_obj_alloc(pic, PIC_TYPE_IREP); + ir->argc = argc; + ir->flags = flags; + ir->frame_size = frame_size; + ir->irepc = irepc; + ir->objc = objc; + ir->codec = codec; + ir->obj = obj; + ir->code = code; + ir->irep = irep; + return ir; +} + +pic_value +pic_deserialize(pic_state *pic, const unsigned char *str) +{ + bin = str; + return obj_value(pic, load_irep(pic)); +} diff --git a/lib/include/picrin.h b/lib/include/picrin.h index bcdcf070..bea40204 100644 --- a/lib/include/picrin.h +++ b/lib/include/picrin.h @@ -333,8 +333,6 @@ void pic_defvar(pic_state *, const char *name, pic_value v); pic_value pic_funcall(pic_state *, const char *name, int n, ...); pic_value pic_values(pic_state *, int n, ...); pic_value pic_vvalues(pic_state *, int n, va_list); -pic_value pic_load(pic_state *, pic_value irep); /* TODO */ -void pic_load_native(pic_state *pic, const char *); /* TODO */ /* diff --git a/lib/include/picrin/extra.h b/lib/include/picrin/extra.h index b63ce5e5..5c65e2ac 100644 --- a/lib/include/picrin/extra.h +++ b/lib/include/picrin/extra.h @@ -17,6 +17,13 @@ void *pic_default_allocf(void *, void *, size_t); pic_value pic_fopen(pic_state *, FILE *, const char *mode); #endif +pic_value pic_load(pic_state *, pic_value irep); /* TODO */ +void pic_load_native(pic_state *pic, const char *); /* TODO */ +pic_value pic_assemble(pic_state *pic, pic_value as); +pic_value pic_execute(pic_state *pic, pic_value irep); +void pic_serialize(pic_state *pic, const char *name, pic_value irep); +pic_value pic_deserialize(pic_state *pic, const unsigned char *bin); + /* for debug */ #if PIC_USE_WRITE diff --git a/lib/load.c b/lib/load.c index 1839a9f1..b0ab016c 100644 --- a/lib/load.c +++ b/lib/load.c @@ -5,174 +5,11 @@ #include "picrin.h" #include "picrin/extra.h" #include "../object.h" -#include "../state.h" - -struct irep * -assemble(pic_state *pic, pic_value as) -{ - pic_value codes, reps, objs; - int argc, varg, frame_size, repc, objc, i; - struct irep **irep, *ir; - pic_value *obj, r, it; - code_t *code; - size_t ai = pic_enter(pic); - - codes = pic_list_ref(pic, as, 0); - reps = pic_list_ref(pic, as, 1); - objs = pic_list_ref(pic, as, 2); - argc = pic_int(pic, pic_car(pic, pic_list_ref(pic, as, 3))); - varg = pic_bool(pic, pic_cdr(pic, pic_list_ref(pic, as, 3))); - frame_size = pic_int(pic, pic_list_ref(pic, as, 4)); - - repc = pic_length(pic, reps); - objc = pic_length(pic, objs); - - assert(0 <= argc && argc < 256); - assert(0 <= frame_size && frame_size < 256); - assert(0 <= repc && repc < 256); - assert(0 <= objc && objc < 256); - - irep = pic_malloc(pic, sizeof(*irep) * repc); - i = 0; - pic_for_each (r, reps, it) { - irep[i++] = assemble(pic, r); - } - obj = pic_malloc(pic, sizeof(*obj) * objc); - i = 0; - pic_for_each (r, objs, it) { - obj[i++] = r; - } - i = 0; - pic_for_each (r, codes, it) { - if (! pic_pair_p(pic, r)) - continue; - if (pic_eq_p(pic, pic_car(pic, r), pic_intern_lit(pic, "COND"))) { - i += 4; - continue; - } - i += pic_length(pic, r); - } - code = pic_malloc(pic, i); - i = 0; - /* TODO: validate operands */ - pic_for_each (r, codes, it) { - pic_value op; - if (! pic_pair_p(pic, r)) - continue; - op = pic_car(pic, r); - if (pic_eq_p(pic, op, pic_intern_lit(pic, "HALT"))) { - code[i++] = OP_HALT; - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "CALL"))) { - code[i++] = OP_CALL; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "PROC"))) { - code[i++] = OP_PROC; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOAD"))) { - code[i++] = OP_LOAD; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LREF"))) { - code[i++] = OP_LREF; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 3)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LSET"))) { - code[i++] = OP_LSET; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 3)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "GREF"))) { - code[i++] = OP_GREF; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "GSET"))) { - code[i++] = OP_GSET; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "COND"))) { - pic_value label = pic_list_ref(pic, r, 2); - pic_value x, it2; - int offset = 0; - pic_for_each (x, it, it2) { - if (pic_eq_p(pic, x, label)) - break; - if (! pic_pair_p(pic, x)) - continue; - if (pic_eq_p(pic, pic_car(pic, x), pic_intern_lit(pic, "COND"))) { - offset += 4; - continue; - } - offset += pic_length(pic, x); - } - code[i++] = OP_COND; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - code[i++] = offset % 256; - code[i++] = offset / 256; - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADT"))) { - code[i++] = OP_LOADT; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADF"))) { - code[i++] = OP_LOADF; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADN"))) { - code[i++] = OP_LOADN; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADU"))) { - code[i++] = OP_LOADU; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - } - else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADI"))) { - code[i++] = OP_LOADI; - code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); - code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); - } - } - - ir = (struct irep *)pic_obj_alloc(pic, PIC_TYPE_IREP); - ir->argc = argc; - ir->flags = (varg ? IREP_VARG : 0); - ir->frame_size = frame_size; - ir->irepc = repc; - ir->objc = objc; - ir->irep = irep; - ir->obj = obj; - ir->code = code; - - pic_leave(pic, ai); - pic_protect(pic, obj_value(pic, ir)); - - return ir; -} - -static pic_value -execute(pic_state *pic, struct irep *irep) -{ - struct proc *proc; - - proc = (struct proc *)pic_obj_alloc(pic, PIC_TYPE_PROC_IREP); - proc->u.irep = irep; - proc->env = NULL; - return pic_apply(pic, obj_value(pic, proc), 0, NULL); -} pic_value pic_load(pic_state *pic, pic_value expr) { - return execute(pic, assemble(pic, expr)); + return pic_execute(pic, pic_assemble(pic, expr)); } void diff --git a/lib/object.h b/lib/object.h index 0269ac62..3f0b6b10 100644 --- a/lib/object.h +++ b/lib/object.h @@ -106,6 +106,7 @@ struct irep { unsigned char flags; unsigned char frame_size; unsigned char irepc, objc; + size_t codec; struct irep **irep; pic_value *obj; const code_t *code; diff --git a/lib/proc.c b/lib/proc.c index 69dc8c64..d7a26a19 100644 --- a/lib/proc.c +++ b/lib/proc.c @@ -6,6 +6,175 @@ #include "object.h" #include "state.h" +static struct irep * +assemble(pic_state *pic, pic_value as) +{ + pic_value codes, reps, objs; + int argc, varg, frame_size, repc, objc, i; + struct irep **irep, *ir; + pic_value *obj, r, it; + code_t *code; + size_t ai = pic_enter(pic); + + codes = pic_list_ref(pic, as, 0); + reps = pic_list_ref(pic, as, 1); + objs = pic_list_ref(pic, as, 2); + argc = pic_int(pic, pic_car(pic, pic_list_ref(pic, as, 3))); + varg = pic_bool(pic, pic_cdr(pic, pic_list_ref(pic, as, 3))); + frame_size = pic_int(pic, pic_list_ref(pic, as, 4)); + + repc = pic_length(pic, reps); + objc = pic_length(pic, objs); + + assert(0 <= argc && argc < 256); + assert(0 <= frame_size && frame_size < 256); + assert(0 <= repc && repc < 256); + assert(0 <= objc && objc < 256); + + irep = pic_malloc(pic, sizeof(*irep) * repc); + i = 0; + pic_for_each (r, reps, it) { + irep[i++] = assemble(pic, r); + } + obj = pic_malloc(pic, sizeof(*obj) * objc); + i = 0; + pic_for_each (r, objs, it) { + obj[i++] = r; + } + i = 0; + pic_for_each (r, codes, it) { + if (! pic_pair_p(pic, r)) + continue; + if (pic_eq_p(pic, pic_car(pic, r), pic_intern_lit(pic, "COND"))) { + i += 4; + continue; + } + i += pic_length(pic, r); + } + code = pic_malloc(pic, i); + i = 0; + /* TODO: validate operands */ + pic_for_each (r, codes, it) { + pic_value op; + if (! pic_pair_p(pic, r)) + continue; + op = pic_car(pic, r); + if (pic_eq_p(pic, op, pic_intern_lit(pic, "HALT"))) { + code[i++] = OP_HALT; + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "CALL"))) { + code[i++] = OP_CALL; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "PROC"))) { + code[i++] = OP_PROC; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOAD"))) { + code[i++] = OP_LOAD; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LREF"))) { + code[i++] = OP_LREF; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 3)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LSET"))) { + code[i++] = OP_LSET; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 3)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "GREF"))) { + code[i++] = OP_GREF; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "GSET"))) { + code[i++] = OP_GSET; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "COND"))) { + pic_value label = pic_list_ref(pic, r, 2); + pic_value x, it2; + int offset = 0; + pic_for_each (x, it, it2) { + if (pic_eq_p(pic, x, label)) + break; + if (! pic_pair_p(pic, x)) + continue; + if (pic_eq_p(pic, pic_car(pic, x), pic_intern_lit(pic, "COND"))) { + offset += 4; + continue; + } + offset += pic_length(pic, x); + } + code[i++] = OP_COND; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + code[i++] = offset % 256; + code[i++] = offset / 256; + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADT"))) { + code[i++] = OP_LOADT; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADF"))) { + code[i++] = OP_LOADF; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADN"))) { + code[i++] = OP_LOADN; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADU"))) { + code[i++] = OP_LOADU; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + } + else if (pic_eq_p(pic, op, pic_intern_lit(pic, "LOADI"))) { + code[i++] = OP_LOADI; + code[i++] = pic_int(pic, pic_list_ref(pic, r, 1)); + code[i++] = pic_int(pic, pic_list_ref(pic, r, 2)); + } + } + + ir = (struct irep *)pic_obj_alloc(pic, PIC_TYPE_IREP); + ir->argc = argc; + ir->flags = (varg ? IREP_VARG : 0); + ir->frame_size = frame_size; + ir->irepc = repc; + ir->objc = objc; + ir->irep = irep; + ir->obj = obj; + ir->code = code; + ir->codec = i; + + pic_leave(pic, ai); + pic_protect(pic, obj_value(pic, ir)); + + return ir; +} + +pic_value +pic_assemble(pic_state *pic, pic_value as) +{ + return obj_value(pic, assemble(pic, as)); +} + +pic_value +pic_execute(pic_state *pic, pic_value irep) +{ + struct proc *proc; + + proc = (struct proc *)pic_obj_alloc(pic, PIC_TYPE_PROC_IREP); + proc->u.irep = irep_ptr(pic, irep); + proc->env = NULL; + return pic_apply(pic, obj_value(pic, proc), 0, NULL); +} + struct frame * pic_make_frame_unsafe(pic_state *pic, int n) { diff --git a/lib/state.c b/lib/state.c index fe625aa7..b986ac24 100644 --- a/lib/state.c +++ b/lib/state.c @@ -208,7 +208,7 @@ pic_open(pic_allocf allocf, void *userdata) /* top continuation */ { - static const code_t halt_code[] = { 0x00, 0x01 }; + static const code_t halt_code[] = { 0x00 }; struct irep *irep; struct proc *proc; irep = (struct irep *)pic_obj_alloc(pic, PIC_TYPE_IREP); @@ -220,6 +220,7 @@ pic_open(pic_allocf allocf, void *userdata) irep->irep = NULL; irep->obj = NULL; irep->code = halt_code; + irep->codec = sizeof halt_code / sizeof halt_code[0]; proc = (struct proc *)pic_obj_alloc(pic, PIC_TYPE_PROC_IREP); proc->u.irep = irep; proc->env = NULL;