WIP: add serializer/deserializer

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\

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 */
+    } else if (argc >= 3 && strcmp(argv[1], "-c") == 0) { /* compile */
-      if (argc == 2) {
+      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);

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));
+}

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 */
 
 
 /*

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

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

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;

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)
 {

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;