WIP: add serializer/deserializer
This commit is contained in:
Yuichi Nishiwaki
parent
187c905861
commit
89667cf994
|
|
@ -20,6 +20,7 @@ LIBPICRIN_SRCS = \
|
|||
var.c\
|
||||
vector.c\
|
||||
weak.c\
|
||||
ext/serialize.c\
|
||||
ext/eval.c\
|
||||
ext/read.c\
|
||||
ext/write.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);
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
}
|
||||
|
|
@ -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 */
|
||||
|
||||
|
||||
/*
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
165
lib/load.c
165
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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
169
lib/proc.c
169
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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue