/** * See Copyright Notice in picrin.h */ #include "picrin.h" #include "value.h" #include "object.h" static void dump1(unsigned char c, unsigned char *buf, int *len) { if (buf) { buf[*len] = c; } *len = *len + 1; } static void dump4(unsigned long n, unsigned char *buf, int *len) { assert(sizeof(long) * CHAR_BIT <= 32 || n <= 0xfffffffful); 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, unsigned char *buf, int *len); #define IREP_FLAGS_MASK (IREP_VARG) static void dump_irep(pic_state *pic, struct irep *irep, unsigned char *buf, int *len) { size_t i; 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], buf, len); } for (i = 0; i < irep->codec; ++i) { dump1(irep->code[i], buf, len); } for (i = 0; i < irep->irepc; ++i) { dump_irep(pic, irep->irep[i], buf, len); } } static void dump_obj(pic_state *pic, pic_value obj, unsigned char *buf, int *len) { if (pic_int_p(pic, obj)) { dump1(0x00, buf, len); dump4(pic_int(pic, obj), buf, len); } else if (pic_str_p(pic, obj)) { 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(0, buf, len); } else if (pic_sym_p(pic, obj)) { 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(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); } if (proc_ptr(pic, obj)->env) { pic_error(pic, "dump: local procedure serialization unsupported", 1, obj); } dump1(0x03, buf, len); dump_irep(pic, proc_ptr(pic, obj)->u.irep, buf, len); } else if (pic_char_p(pic, obj)) { dump1(0x04, buf, len); dump1(pic_char(pic, obj), buf, len); } else { pic_error(pic, "dump: unsupported object", 1, obj); } } pic_value pic_serialize(pic_state *pic, pic_value obj) { int len = 0; pic_value blob; 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 void loadn(pic_state *pic, unsigned char *dst, size_t size, const unsigned char **buf, const unsigned char *end) { if (*buf + size > end) { pic_error(pic, "malformed bytevector", 0); } memcpy(dst, *buf, size); *buf = *buf + size; } static unsigned char load1(pic_state *pic, const unsigned char **buf, const unsigned char *end) { unsigned char c; loadn(pic, &c, 1, buf, end); return c; } static unsigned long load4(pic_state *pic, const unsigned char **buf, const unsigned char *end) { unsigned long x = load1(pic, buf, end); x += load1(pic, buf, end) << 8; x += load1(pic, buf, end) << 16; x += load1(pic, buf, end) << 24; return x; } static pic_value load_obj(pic_state *pic, const unsigned char **buf, const unsigned char *end); static struct irep * load_irep(pic_state *pic, const unsigned char **buf, const unsigned char *end) { unsigned char argc, flags, frame_size, irepc, objc; size_t codec, i; pic_value *obj; unsigned char *code; struct irep **irep, *ir; size_t ai = pic_enter(pic); argc = load1(pic, buf, end); flags = load1(pic, buf, end); frame_size = load1(pic, buf, end); irepc = load1(pic, buf, end); objc = load1(pic, buf, end); codec = load4(pic, buf, end); obj = pic_malloc(pic, sizeof(pic_value) * objc); for (i = 0; i < objc; ++i) { obj[i] = load_obj(pic, buf, end); } code = pic_malloc(pic, codec); /* TODO */ loadn(pic, code, codec, buf, end); irep = pic_malloc(pic, sizeof(struct irep *) * irepc); for (i = 0; i < irepc; ++i) { irep[i] = load_irep(pic, buf, end); } 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; pic_leave(pic, ai); pic_protect(pic, obj_value(pic, ir)); return ir; } static pic_value load_obj(pic_state *pic, const unsigned char **buf, const unsigned char *end) { int type, l; pic_value obj; char *dat, c; struct irep *irep; struct proc *proc; type = load1(pic, buf, end); switch (type) { case 0x00: return pic_int_value(pic, load4(pic, buf, end)); case 0x01: l = load4(pic, buf, end); dat = pic_malloc(pic, l + 1); /* TODO */ loadn(pic, (unsigned char *) dat, l + 1, buf, end); obj = pic_str_value(pic, dat, l); pic_free(pic, dat); return obj; case 0x02: l = load4(pic, buf, end); dat = pic_malloc(pic, l + 1); /* TODO */ loadn(pic, (unsigned char *) dat, l + 1, buf, end); obj = pic_intern_str(pic, dat, l); pic_free(pic, dat); return obj; case 0x03: irep = load_irep(pic, buf, end); 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, buf, end); return pic_char_value(pic, c); default: pic_error(pic, "load: unsupported object", 1, pic_int_value(pic, type)); } } pic_value pic_deserialize(pic_state *pic, pic_value blob) { int len; const unsigned char *buf = pic_blob(pic, blob, &len); return load_obj(pic, &buf, buf + len); } pic_value pic_blob_value(pic_state *pic, const unsigned char *buf, int len) { struct blob *bv; bv = (struct blob *)pic_obj_alloc(pic, PIC_TYPE_BLOB); bv->data = pic_malloc(pic, len); bv->len = len; if (buf) { memcpy(bv->data, buf, len); } return obj_value(pic, bv); } unsigned char * pic_blob(pic_state *pic, pic_value blob, int *len) { struct blob *bv = blob_ptr(pic, blob); if (len) { *len = bv->len; } return bv->data; } static pic_value pic_blob_bytevector_p(pic_state *pic) { pic_value v; pic_get_args(pic, "o", &v); return pic_bool_value(pic, pic_blob_p(pic, v)); } static pic_value pic_blob_bytevector(pic_state *pic) { pic_value *argv, blob; int argc, i; unsigned char *data; pic_get_args(pic, "*", &argc, &argv); blob = pic_blob_value(pic, 0, argc); data = pic_blob(pic, blob, NULL); for (i = 0; i < argc; ++i) { TYPE_CHECK(pic, argv[i], int); if (pic_int(pic, argv[i]) < 0 || pic_int(pic, argv[i]) > 255) { pic_error(pic, "byte out of range", 1, argv[i]); } *data++ = (unsigned char)pic_int(pic, argv[i]); } return blob; } static pic_value pic_blob_make_bytevector(pic_state *pic) { pic_value blob; int k, b = 0; pic_get_args(pic, "i|i", &k, &b); if (b < 0 || b > 255) pic_error(pic, "byte out of range", 1, pic_int_value(pic, b)); if (k < 0) { pic_error(pic, "make-bytevector: negative length given", 1, pic_int_value(pic, k)); } blob = pic_blob_value(pic, 0, k); memset(pic_blob(pic, blob, NULL), (unsigned char)b, k); return blob; } static pic_value pic_blob_bytevector_length(pic_state *pic) { int len; pic_get_args(pic, "b", NULL, &len); return pic_int_value(pic, len); } static pic_value pic_blob_bytevector_u8_ref(pic_state *pic) { unsigned char *buf; int len, k; pic_get_args(pic, "bi", &buf, &len, &k); VALID_INDEX(pic, len, k); return pic_int_value(pic, buf[k]); } static pic_value pic_blob_bytevector_u8_set(pic_state *pic) { unsigned char *buf; int len, k, v; pic_get_args(pic, "bii", &buf, &len, &k, &v); if (v < 0 || v > 255) pic_error(pic, "byte out of range", 1, pic_int_value(pic, v)); VALID_INDEX(pic, len, k); buf[k] = (unsigned char)v; return pic_undef_value(pic); } static pic_value pic_blob_bytevector_copy_i(pic_state *pic) { unsigned char *to, *from; int n, at, start, end, tolen, fromlen; n = pic_get_args(pic, "bib|ii", &to, &tolen, &at, &from, &fromlen, &start, &end); switch (n) { case 3: start = 0; case 4: end = fromlen; } VALID_ATRANGE(pic, tolen, at, fromlen, start, end); memmove(to + at, from + start, end - start); return pic_undef_value(pic); } static pic_value pic_blob_bytevector_copy(pic_state *pic) { unsigned char *buf; int n, start, end, len; n = pic_get_args(pic, "b|ii", &buf, &len, &start, &end); switch (n) { case 1: start = 0; case 2: end = len; } VALID_RANGE(pic, len, start, end); return pic_blob_value(pic, buf + start, end - start); } static pic_value pic_blob_bytevector_append(pic_state *pic) { int argc, i, l, len; unsigned char *buf, *dst; pic_value *argv, blob; pic_get_args(pic, "*", &argc, &argv); len = 0; for (i = 0; i < argc; ++i) { TYPE_CHECK(pic, argv[i], blob); pic_blob(pic, argv[i], &l); len += l; } blob = pic_blob_value(pic, NULL, len); dst = pic_blob(pic, blob, NULL); len = 0; for (i = 0; i < argc; ++i) { buf = pic_blob(pic, argv[i], &l); memcpy(dst + len, buf, l); len += l; } return blob; } static pic_value pic_blob_list_to_bytevector(pic_state *pic) { pic_value blob; unsigned char *data; pic_value list, e, it; pic_get_args(pic, "o", &list); blob = pic_blob_value(pic, 0, pic_length(pic, list)); data = pic_blob(pic, blob, NULL); pic_for_each (e, list, it) { TYPE_CHECK(pic, e, int); if (pic_int(pic, e) < 0 || pic_int(pic, e) > 255) pic_error(pic, "byte out of range", 0); *data++ = (unsigned char)pic_int(pic, e); } return blob; } static pic_value pic_blob_bytevector_to_list(pic_state *pic) { pic_value list; unsigned char *buf; int n, len, start, end, i; n = pic_get_args(pic, "b|ii", &buf, &len, &start, &end); switch (n) { case 1: start = 0; case 2: end = len; } VALID_RANGE(pic, len, start, end); list = pic_nil_value(pic); for (i = start; i < end; ++i) { pic_push(pic, pic_int_value(pic, buf[i]), list); } return pic_reverse(pic, list); } static pic_value pic_blob_object_to_bytevector(pic_state *pic) { pic_value obj; pic_get_args(pic, "o", &obj); return pic_serialize(pic, obj); } static pic_value pic_blob_bytevector_to_object(pic_state *pic) { pic_value blob; pic_get_args(pic, "o", &blob); TYPE_CHECK(pic, blob, blob); return pic_deserialize(pic, blob); } void pic_init_blob(pic_state *pic) { pic_defun(pic, "bytevector?", pic_blob_bytevector_p); pic_defun(pic, "bytevector", pic_blob_bytevector); pic_defun(pic, "make-bytevector", pic_blob_make_bytevector); pic_defun(pic, "bytevector-length", pic_blob_bytevector_length); pic_defun(pic, "bytevector-u8-ref", pic_blob_bytevector_u8_ref); pic_defun(pic, "bytevector-u8-set!", pic_blob_bytevector_u8_set); pic_defun(pic, "bytevector-copy!", pic_blob_bytevector_copy_i); pic_defun(pic, "bytevector-copy", pic_blob_bytevector_copy); pic_defun(pic, "bytevector-append", pic_blob_bytevector_append); pic_defun(pic, "bytevector->list", pic_blob_bytevector_to_list); pic_defun(pic, "list->bytevector", pic_blob_list_to_bytevector); pic_defun(pic, "bytevector->object", pic_blob_bytevector_to_object); pic_defun(pic, "object->bytevector", pic_blob_object_to_bytevector); }