pic_str *
pic_get_backtrace(pic_state *pic)
{
size_t ai = pic_gc_arena_preserve(pic);
pic_callinfo *ci;
pic_str *trace;
trace = pic_make_str(pic, NULL, 0);
for (ci = pic->ci; ci != pic->cibase; --ci) {
struct pic_proc *proc = pic_proc_ptr(ci->fp[0]);
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " at "));
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, pic_symbol_name(pic, pic_proc_name(proc))));
if (pic_proc_func_p(proc)) {
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (native function)\n"));
} else if (pic_proc_irep_p(proc)) {
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (unknown location)\n")); /* TODO */
}
}
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, pic_obj_value(trace));
return trace;
}
static pic_value
pic_system_getenvs(pic_state *pic)
{
char **envp;
pic_value data = pic_nil_value();
size_t ai = pic_gc_arena_preserve(pic);
pic_get_args(pic, "");
if (! pic->envp) {
return pic_nil_value();
}
for (envp = pic->envp; *envp; ++envp) {
pic_str *key, *val;
size_t i;
for (i = 0; (*envp)[i] != '='; ++i)
;
key = pic_make_str(pic, *envp, i);
val = pic_make_str_cstr(pic, getenv(pic_str_cstr(key)));
/* push */
data = pic_acons(pic, pic_obj_value(key), pic_obj_value(val), data);
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, data);
}
return data;
}
pic_value
pic_list3(pic_state *pic, pic_value obj1, pic_value obj2, pic_value obj3)
{
size_t ai = pic_gc_arena_preserve(pic);
pic_value val;
val = pic_cons(pic, obj1, pic_list2(pic, obj2, obj3));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, val);
return val;
}
pic_value
pic_list7(pic_state *pic, pic_value obj1, pic_value obj2, pic_value obj3, pic_value obj4, pic_value obj5, pic_value obj6, pic_value obj7)
{
size_t ai = pic_gc_arena_preserve(pic);
pic_value val;
val = pic_cons(pic, obj1, pic_list6(pic, obj2, obj3, obj4, obj5, obj6, obj7));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, val);
return val;
}
pic_value
pic_list5(pic_state *pic, pic_value obj1, pic_value obj2, pic_value obj3, pic_value obj4, pic_value obj5)
{
int ai = pic_gc_arena_preserve(pic);
pic_value val;
val = pic_cons(pic, obj1, pic_list4(pic, obj2, obj3, obj4, obj5));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, val);
return val;
}
void
pic_load(pic_state *pic, struct pic_port *port)
{
pic_value form;
size_t ai = pic_gc_arena_preserve(pic);
while (! pic_eof_p(form = pic_read(pic, port))) {
pic_eval(pic, form, pic->lib->env);
pic_gc_arena_restore(pic, ai);
}
}
pic_value
pic_reverse(pic_state *pic, pic_value list)
{
size_t ai = pic_gc_arena_preserve(pic);
pic_value v, acc, it;
acc = pic_nil_value();
pic_for_each(v, list, it) {
acc = pic_cons(pic, v, acc);
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, acc);
}
static pic_value
pic_system_cmdline(pic_state *pic)
{
pic_value v = pic_nil_value();
int i;
pic_get_args(pic, "");
for (i = 0; i < pic->argc; ++i) {
size_t ai = pic_gc_arena_preserve(pic);
v = pic_cons(pic, pic_obj_value(pic_make_str_cstr(pic, pic->argv[i])), v);
pic_gc_arena_restore(pic, ai);
}
return pic_reverse(pic, v);
}
void
pic_init_core(pic_state *pic)
{
int ai;
ai = pic_gc_arena_preserve(pic);
pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE;
pic_init_port(pic); DONE;
pic_init_number(pic); DONE;
pic_init_time(pic); DONE;
pic_init_system(pic); DONE;
pic_init_file(pic); DONE;
pic_init_proc(pic); DONE;
pic_init_symbol(pic); DONE;
pic_init_vector(pic); DONE;
pic_init_blob(pic); DONE;
pic_load_stdlib(pic); DONE;
}
pic_state *
pic_open(int argc, char *argv[], char **envp)
{
pic_value t;
pic_state *pic;
int ai;
pic = (pic_state *)malloc(sizeof(pic_state));
/* command line */
pic->argc = argc;
pic->argv = argv;
pic->envp = envp;
/* root block */
pic->blk = (struct pic_block *)malloc(sizeof(struct pic_block));
pic->blk->prev = NULL;
pic->blk->depth = 0;
pic->blk->in = pic->blk->out = NULL;
pic->blk->refcnt = 1;
/* prepare VM stack */
pic->stbase = pic->sp = (pic_value *)calloc(PIC_STACK_SIZE, sizeof(pic_value));
pic->stend = pic->stbase + PIC_STACK_SIZE;
/* callinfo */
pic->cibase = pic->ci = (pic_callinfo *)calloc(PIC_STACK_SIZE, sizeof(pic_callinfo));
pic->ciend = pic->cibase + PIC_STACK_SIZE;
/* exception handlers */
pic->rescue = (struct pic_proc **)calloc(PIC_RESCUE_SIZE, sizeof(struct pic_proc *));
pic->ridx = 0;
pic->rlen = PIC_RESCUE_SIZE;
/* memory heap */
pic->heap = (struct pic_heap *)calloc(1, sizeof(struct pic_heap));
init_heap(pic->heap);
/* symbol table */
pic->sym_tbl = xh_new();
pic->sym_pool = (const char **)calloc(PIC_SYM_POOL_SIZE, sizeof(const char *));
pic->slen = 0;
pic->scapa = pic->slen + PIC_SYM_POOL_SIZE;
pic->uniq_sym_count = 0;
/* global variables */
pic->global_tbl = xh_new();
pic->globals = (pic_value *)calloc(PIC_GLOBALS_SIZE, sizeof(pic_value));
pic->glen = 0;
pic->gcapa = PIC_GLOBALS_SIZE;
/* libraries */
pic->lib_tbl = pic_nil_value();
pic->lib = NULL;
/* error handling */
pic->jmp = NULL;
pic->errmsg = NULL;
/* GC arena */
pic->arena_idx = 0;
/* native stack marker */
pic->native_stack_start = &t;
#define register_core_symbol(pic,slot,name) do { \
pic->slot = pic_intern_cstr(pic, name); \
} while (0)
ai = pic_gc_arena_preserve(pic);
register_core_symbol(pic, sDEFINE, "define");
register_core_symbol(pic, sLAMBDA, "lambda");
register_core_symbol(pic, sIF, "if");
register_core_symbol(pic, sBEGIN, "begin");
register_core_symbol(pic, sSETBANG, "set!");
register_core_symbol(pic, sQUOTE, "quote");
register_core_symbol(pic, sQUASIQUOTE, "quasiquote");
register_core_symbol(pic, sUNQUOTE, "unquote");
register_core_symbol(pic, sUNQUOTE_SPLICING, "unquote-splicing");
register_core_symbol(pic, sDEFINE_SYNTAX, "define-syntax");
register_core_symbol(pic, sDEFINE_MACRO, "define-macro");
register_core_symbol(pic, sDEFINE_LIBRARY, "define-library");
register_core_symbol(pic, sIMPORT, "import");
register_core_symbol(pic, sEXPORT, "export");
register_core_symbol(pic, sCONS, "cons");
register_core_symbol(pic, sCAR, "car");
register_core_symbol(pic, sCDR, "cdr");
register_core_symbol(pic, sNILP, "null?");
register_core_symbol(pic, sADD, "+");
register_core_symbol(pic, sSUB, "-");
register_core_symbol(pic, sMUL, "*");
register_core_symbol(pic, sDIV, "/");
register_core_symbol(pic, sMINUS, "minus");
register_core_symbol(pic, sEQ, "=");
register_core_symbol(pic, sLT, "<");
register_core_symbol(pic, sLE, "<=");
register_core_symbol(pic, sGT, ">");
register_core_symbol(pic, sGE, ">=");
pic_gc_arena_restore(pic, ai);
pic_init_core(pic);
/* set library */
pic_make_library(pic, pic_parse(pic, "user"));
pic_in_library(pic, pic_parse(pic, "user"));
return pic;
}
pic_state *
pic_open(int argc, char *argv[], char **envp)
{
struct pic_port *pic_make_standard_port(pic_state *, xFILE *, short);
char t;
pic_state *pic;
size_t ai;
pic = malloc(sizeof(pic_state));
/* turn off GC */
pic->gc_enable = false;
/* root block */
pic->wind = NULL;
/* command line */
pic->argc = argc;
pic->argv = argv;
pic->envp = envp;
/* prepare VM stack */
pic->stbase = pic->sp = calloc(PIC_STACK_SIZE, sizeof(pic_value));
pic->stend = pic->stbase + PIC_STACK_SIZE;
/* callinfo */
pic->cibase = pic->ci = calloc(PIC_STACK_SIZE, sizeof(pic_callinfo));
pic->ciend = pic->cibase + PIC_STACK_SIZE;
/* exception handler */
pic->xpbase = pic->xp = calloc(PIC_RESCUE_SIZE, sizeof(struct pic_proc *));
pic->xpend = pic->xpbase + PIC_RESCUE_SIZE;
/* memory heap */
pic->heap = pic_heap_open();
/* symbol table */
xh_init_str(&pic->syms, sizeof(pic_sym *));
/* global variables */
pic->globals = NULL;
/* macros */
pic->macros = NULL;
/* attributes */
xh_init_ptr(&pic->attrs, sizeof(struct pic_dict *));
/* features */
pic->features = pic_nil_value();
/* libraries */
pic->libs = pic_nil_value();
pic->lib = NULL;
/* GC arena */
pic->arena = calloc(PIC_ARENA_SIZE, sizeof(struct pic_object **));
pic->arena_size = PIC_ARENA_SIZE;
pic->arena_idx = 0;
/* raised error object */
pic->err = pic_undef_value();
/* standard ports */
pic->xSTDIN = NULL;
pic->xSTDOUT = NULL;
pic->xSTDERR = NULL;
/* native stack marker */
pic->native_stack_start = &t;
ai = pic_gc_arena_preserve(pic);
#define S(slot,name) pic->slot = pic_intern_cstr(pic, name);
S(sDEFINE, "define");
S(sLAMBDA, "lambda");
S(sIF, "if");
S(sBEGIN, "begin");
S(sSETBANG, "set!");
S(sQUOTE, "quote");
S(sQUASIQUOTE, "quasiquote");
S(sUNQUOTE, "unquote");
S(sUNQUOTE_SPLICING, "unquote-splicing");
S(sDEFINE_SYNTAX, "define-syntax");
S(sIMPORT, "import");
S(sEXPORT, "export");
S(sDEFINE_LIBRARY, "define-library");
S(sIN_LIBRARY, "in-library");
S(sCOND_EXPAND, "cond-expand");
S(sAND, "and");
S(sOR, "or");
S(sELSE, "else");
S(sLIBRARY, "library");
S(sONLY, "only");
S(sRENAME, "rename");
S(sPREFIX, "prefix");
S(sEXCEPT, "except");
S(sCONS, "cons");
S(sCAR, "car");
S(sCDR, "cdr");
S(sNILP, "null?");
S(sSYMBOLP, "symbol?");
S(sPAIRP, "pair?");
S(sADD, "+");
S(sSUB, "-");
S(sMUL, "*");
S(sDIV, "/");
S(sMINUS, "minus");
S(sEQ, "=");
S(sLT, "<");
S(sLE, "<=");
S(sGT, ">");
S(sGE, ">=");
S(sNOT, "not");
S(sREAD, "read");
S(sFILE, "file");
S(sCALL, "call");
S(sTAILCALL, "tail-call");
S(sGREF, "gref");
S(sLREF, "lref");
S(sCREF, "cref");
S(sRETURN, "return");
S(sCALL_WITH_VALUES, "call-with-values");
S(sTAILCALL_WITH_VALUES, "tailcall-with-values");
pic_gc_arena_restore(pic, ai);
#define R(slot,name) pic->slot = pic_gensym(pic, pic_intern_cstr(pic, name));
R(rDEFINE, "define");
R(rLAMBDA, "lambda");
R(rIF, "if");
R(rBEGIN, "begin");
R(rSETBANG, "set!");
R(rQUOTE, "quote");
R(rDEFINE_SYNTAX, "define-syntax");
R(rIMPORT, "import");
R(rEXPORT, "export");
R(rDEFINE_LIBRARY, "define-library");
R(rIN_LIBRARY, "in-library");
R(rCOND_EXPAND, "cond-expand");
pic_gc_arena_restore(pic, ai);
/* root tables */
pic->globals = pic_make_dict(pic);
pic->macros = pic_make_dict(pic);
/* root block */
pic->wind = pic_alloc(pic, sizeof(struct pic_winder));
pic->wind->prev = NULL;
pic->wind->depth = 0;
pic->wind->in = pic->wind->out = NULL;
/* reader */
pic->reader = malloc(sizeof(struct pic_reader));
pic->reader->typecase = PIC_CASE_DEFAULT;
pic->reader->trie = pic_make_trie(pic);
xh_init_int(&pic->reader->labels, sizeof(pic_value));
/* init readers */
pic_init_reader(pic);
/* standard libraries */
pic->PICRIN_BASE = pic_open_library(pic, pic_read_cstr(pic, "(picrin base)"));
pic->PICRIN_USER = pic_open_library(pic, pic_read_cstr(pic, "(picrin user)"));
pic->lib = pic->PICRIN_USER;
/* standard I/O */
pic->xSTDIN = pic_make_standard_port(pic, xstdin, PIC_PORT_IN);
pic->xSTDOUT = pic_make_standard_port(pic, xstdout, PIC_PORT_OUT);
pic->xSTDERR = pic_make_standard_port(pic, xstderr, PIC_PORT_OUT);
pic_gc_arena_restore(pic, ai);
/* turn on GC */
pic->gc_enable = true;
pic_init_core(pic);
return pic;
}
pic_value
pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
{
struct pic_code *pc, c;
int ai = pic_gc_arena_preserve(pic);
jmp_buf jmp;
size_t argc, i;
struct pic_code boot[2];
#if PIC_DIRECT_THREADED_VM
static void *oplabels[] = {
&&L_OP_POP, &&L_OP_PUSHNIL, &&L_OP_PUSHTRUE, &&L_OP_PUSHFALSE, &&L_OP_PUSHFLOAT,
&&L_OP_PUSHINT, &&L_OP_PUSHCHAR, &&L_OP_PUSHCONST,
&&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_LSET, &&L_OP_CREF, &&L_OP_CSET,
&&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_CALL, &&L_OP_TAILCALL, &&L_OP_RET, &&L_OP_LAMBDA,
&&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP,
&&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV,
&&L_OP_EQ, &&L_OP_LT, &&L_OP_LE, &&L_OP_STOP
};
#endif
if (setjmp(jmp) == 0) {
pic->jmp = &jmp;
}
else {
goto L_RAISE;
}
argc = pic_length(pic, argv) + 1;
#if VM_DEBUG
puts("== booting VM...");
printf(" proc = ");
pic_debug(pic, pic_obj_value(proc));
puts("");
printf(" argv = ");
pic_debug(pic, argv);
puts("");
printf(" irep = ");
print_irep(pic, proc->u.irep);
puts("\nLet's go!");
#endif
PUSH(pic_obj_value(proc));
for (i = 1; i < argc; ++i) {
PUSH(pic_car(pic, argv));
argv = pic_cdr(pic, argv);
}
/* boot! */
boot[0].insn = OP_CALL;
boot[0].u.i = argc;
boot[1].insn = OP_STOP;
pc = boot;
c = *pc;
goto L_CALL;
VM_LOOP {
CASE(OP_POP) {
POPN(1);
NEXT;
}
CASE(OP_PUSHNIL) {
PUSH(pic_nil_value());
NEXT;
}
CASE(OP_PUSHTRUE) {
PUSH(pic_true_value());
NEXT;
}
CASE(OP_PUSHFALSE) {
PUSH(pic_false_value());
NEXT;
}
CASE(OP_PUSHFLOAT) {
PUSH(pic_float_value(c.u.f));
NEXT;
}
CASE(OP_PUSHINT) {
PUSH(pic_int_value(c.u.i));
NEXT;
}
CASE(OP_PUSHCHAR) {
PUSH(pic_char_value(c.u.c));
NEXT;
}
CASE(OP_PUSHCONST) {
PUSH(pic->pool[c.u.i]);
NEXT;
}
CASE(OP_GREF) {
PUSH(pic->globals[c.u.i]);
NEXT;
}
CASE(OP_GSET) {
pic->globals[c.u.i] = POP();
NEXT;
}
CASE(OP_LREF) {
PUSH(pic->ci->fp[c.u.i]);
NEXT;
}
CASE(OP_LSET) {
pic->ci->fp[c.u.i] = POP();
NEXT;
}
CASE(OP_CREF) {
int depth = c.u.r.depth;
struct pic_env *env;
env = pic->ci->env;
while (depth--) {
env = env->up;
}
PUSH(env->values[c.u.r.idx]);
NEXT;
}
CASE(OP_CSET) {
int depth = c.u.r.depth;
struct pic_env *env;
env = pic->ci->env;
while (depth--) {
env = env->up;
}
env->values[c.u.r.idx] = POP();
NEXT;
}
CASE(OP_JMP) {
pc += c.u.i;
JUMP;
}
CASE(OP_JMPIF) {
pic_value v;
v = POP();
if (! pic_false_p(v)) {
pc += c.u.i;
JUMP;
}
NEXT;
}
CASE(OP_CALL) {
pic_value x, v;
pic_callinfo *ci;
struct pic_proc *proc;
L_CALL:
x = pic->sp[-c.u.i];
if (! pic_proc_p(x)) {
pic->errmsg = "invalid application";
goto L_RAISE;
}
proc = pic_proc_ptr(x);
ci = PUSHCI();
ci->argc = c.u.i;
ci->pc = pc;
ci->fp = pic->sp - c.u.i;
ci->env = NULL;
if (pic_proc_cfunc_p(x)) {
v = proc->u.cfunc(pic);
pic->sp = ci->fp;
POPCI();
PUSH(v);
pic_gc_arena_restore(pic, ai);
NEXT;
}
else {
int i;
pic_value rest;
if (ci->argc != proc->u.irep->argc) {
if (! (proc->u.irep->varg && ci->argc >= proc->u.irep->argc)) {
pic->errmsg = "wrong number of arguments";
goto L_RAISE;
}
}
/* prepare rest args */
if (proc->u.irep->varg) {
rest = pic_nil_value();
for (i = 0; i < ci->argc - proc->u.irep->argc; ++i) {
pic_gc_protect(pic, v = POP());
rest = pic_cons(pic, v, rest);
}
PUSH(rest);
}
/* prepare env */
if (proc->u.irep->cv_num == 0) {
ci->env = proc->env;
}
else {
ci->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
ci->env->up = proc->env;
ci->env->valuec = proc->u.irep->cv_num;
ci->env->values = (pic_value *)pic_calloc(pic, ci->env->valuec, sizeof(pic_value));
for (i = 0; i < ci->env->valuec; ++i) {
ci->env->values[i] = ci->fp[proc->u.irep->cv_tbl[i]];
}
}
pc = proc->u.irep->code;
pic_gc_arena_restore(pic, ai);
JUMP;
}
}
CASE(OP_TAILCALL) {
int argc;
pic_value *argv;
argc = c.u.i;
argv = pic->sp - argc;
for (i = 0; i < argc; ++i) {
pic->ci->fp[i] = argv[i];
}
pic->sp = pic->ci->fp + argc;
pc = POPCI()->pc;
/* c is not changed */
goto L_CALL;
}
CASE(OP_RET) {
pic_value v;
pic_callinfo *ci;
if (pic->errmsg) {
L_RAISE:
goto L_STOP;
}
else {
v = POP();
ci = POPCI();
pc = ci->pc;
pic->sp = ci->fp;
PUSH(v);
}
NEXT;
}
CASE(OP_LAMBDA) {
struct pic_proc *proc;
proc = pic_proc_new(pic, pic->irep[c.u.i], pic->ci->env);
PUSH(pic_obj_value(proc));
pic_gc_arena_restore(pic, ai);
NEXT;
}
CASE(OP_CONS) {
pic_value a, b;
pic_gc_protect(pic, b = POP());
pic_gc_protect(pic, a = POP());
PUSH(pic_cons(pic, a, b));
pic_gc_arena_restore(pic, ai);
NEXT;
}
CASE(OP_CAR) {
pic_value p;
p = POP();
PUSH(pic_car(pic, p));
NEXT;
}
CASE(OP_CDR) {
pic_value p;
p = POP();
PUSH(pic_cdr(pic, p));
NEXT;
}
CASE(OP_NILP) {
pic_value p;
p = POP();
PUSH(pic_bool_value(pic_nil_p(p)));
NEXT;
}
#define DEFINE_ARITH_OP(opcode, op) \
CASE(opcode) { \
pic_value a, b; \
b = POP(); \
a = POP(); \
if (pic_int_p(a) && pic_int_p(b)) { \
double f = (double)pic_int(a) op (double)pic_int(b); \
if (INT_MIN <= f && f <= INT_MAX) { \
PUSH(pic_int_value((int)f)); \
} \
else { \
PUSH(pic_float_value(f)); \
} \
} \
else if (pic_float_p(a) && pic_float_p(b)) { \
PUSH(pic_float_value(pic_float(a) op pic_float(b))); \
} \
else if (pic_int_p(a) && pic_float_p(b)) { \
PUSH(pic_float_value(pic_int(a) op pic_float(b))); \
} \
else if (pic_float_p(a) && pic_int_p(b)) { \
PUSH(pic_float_value(pic_float(a) op pic_int(b))); \
} \
else { \
pic->errmsg = #op " got non-number operands"; \
goto L_RAISE; \
} \
NEXT; \
}
DEFINE_ARITH_OP(OP_ADD, +);
DEFINE_ARITH_OP(OP_SUB, -);
DEFINE_ARITH_OP(OP_MUL, *);
/* special care for (int / int) division */
CASE(OP_DIV) {
pic_value a, b;
b = POP();
a = POP();
if (pic_int_p(a) && pic_int_p(b)) {
PUSH(pic_float_value((double)pic_int(a) / pic_int(b)));
}
else if (pic_float_p(a) && pic_float_p(b)) {
PUSH(pic_float_value(pic_float(a) / pic_float(b)));
}
else if (pic_int_p(a) && pic_float_p(b)) {
PUSH(pic_float_value(pic_int(a) / pic_float(b)));
}
else if (pic_float_p(a) && pic_int_p(b)) {
PUSH(pic_float_value(pic_float(a) / pic_int(b)));
}
else {
pic->errmsg = "/ got non-number operands";
goto L_RAISE;
}
NEXT;
}
#define DEFINE_COMP_OP(opcode, op) \
CASE(opcode) { \
pic_value a, b; \
b = POP(); \
a = POP(); \
if (pic_int_p(a) && pic_int_p(b)) { \
PUSH(pic_bool_value(pic_int(a) op pic_int(b))); \
} \
else if (pic_float_p(a) && pic_float_p(b)) { \
PUSH(pic_bool_value(pic_float(a) op pic_float(b))); \
} \
else if (pic_int_p(a) && pic_int_p(b)) { \
PUSH(pic_bool_value(pic_int(a) op pic_float(b))); \
} \
else if (pic_float_p(a) && pic_int_p(b)) { \
PUSH(pic_bool_value(pic_float(a) op pic_int(b))); \
} \
else { \
pic->errmsg = #op " got non-number operands"; \
goto L_RAISE; \
} \
NEXT; \
}
DEFINE_COMP_OP(OP_EQ, ==);
DEFINE_COMP_OP(OP_LT, <);
DEFINE_COMP_OP(OP_LE, <=);
CASE(OP_STOP) {
pic_value val;
L_STOP:
val = POP();
pic->jmp = NULL;
if (pic->errmsg) {
return pic_undef_value();
}
#if VM_DEBUG
puts("**VM END STATE**");
printf("stbase\t= %p\nsp\t= %p\n", pic->stbase, pic->sp);
printf("cibase\t= %p\nci\t= %p\n", pic->cibase, pic->ci);
if (pic->stbase < pic->sp) {
pic_value *sp;
printf("* stack trace:");
for (sp = pic->stbase; pic->sp != sp; ++sp) {
pic_debug(pic, *sp);
puts("");
}
}
if (pic->stbase > pic->sp) {
puts("*** stack underflow!");
}
#endif
pic_gc_protect(pic, val);
return val;
}
} VM_LOOP_END;
}
