PUBLIC void vm_raise(VMSTATE vms, OBJ exception, OBJ arg) {
if (vms->r->vm_trap_closure != NULL) {
VECTOR argvec = newvector_noinit(5);
push_frame(vms);
#ifdef DEBUG
printf("%p raising %s\n", current_thread, ((BVECTOR) AT((OVECTOR) exception, SY_NAME))->vec);
#endif
ATPUT(argvec, 0, NULL);
ATPUT(argvec, 1, exception);
ATPUT(argvec, 2, arg);
ATPUT(argvec, 3, (OBJ) getcont_from(vms));
ATPUT(argvec, 4, vms->r->vm_acc);
vms->c.vm_top = 0;
apply_closure(vms, vms->r->vm_trap_closure, argvec);
vms->r->vm_frame = NULL; /* If it ever returns, the thread dies. */
} else {
if (OVECTORP(exception) && ((OVECTOR) exception)->type == T_SYMBOL)
fprintf(stderr, "excp sym = '%s\n", ((BVECTOR) AT((OVECTOR) exception, SY_NAME))->vec);
if (OVECTORP(arg) && ((OVECTOR) arg)->type == T_SYMBOL)
fprintf(stderr, "arg sym = '%s\n", ((BVECTOR) AT((OVECTOR) arg, SY_NAME))->vec);
if (BVECTORP(arg))
fprintf(stderr, "arg str = %s\n", ((BVECTOR) arg)->vec);
fprintf(stderr,
"Exception raised, no handler installed -> vm death.\n");
vms->c.vm_state = VM_STATE_DYING;
}
}
// socket-send
scm_obj_t
subr_socket_send(VM* vm, int argc, scm_obj_t argv[])
{
if (argc == 3) {
if (SOCKETP(argv[0])) {
if (BVECTORP(argv[1])) {
int m_flags;
CONVERT_TO_MACHINE_INT(2, "socket-send", &m_flags);
scm_socket_t socket = (scm_socket_t)argv[0];
if (socket->fd != INVALID_SOCKET) {
try {
scm_bvector_t bv = (scm_bvector_t)argv[1];
return MAKEFIXNUM(socket_send(socket, bv->elts, bv->count, m_flags));
} catch (io_exception_t& e) {
raise_io_error(vm, "socket-send", e.m_operation, e.m_message, e.m_err, socket, scm_false);
return scm_undef;
}
}
wrong_type_argument_violation(vm, "socket-send", 0, "connected socket", argv[0], argc, argv);
return scm_undef;
}
wrong_type_argument_violation(vm, "socket-send", 1, "bytevector", argv[1], argc, argv);
return scm_undef;
}
wrong_type_argument_violation(vm, "socket-send", 0, "socket", argv[0], argc, argv);
return scm_undef;
}
wrong_number_of_arguments_violation(vm, "socket-send", 3, 3, argc, argv);
return scm_undef;
}
// shared-bag-put!
scm_obj_t
subr_shared_bag_put(VM* vm, int argc, scm_obj_t argv[])
{
#if USE_PARALLEL_VM
if (argc == 3 || argc == 4) {
if (SHAREDBAGP(argv[0])) {
if (STRINGP(argv[1])) {
int timeout = 0;
if (argc == 4) {
if (FIXNUMP(argv[3]) && FIXNUM(argv[3]) >= 0) {
timeout = FIXNUM(argv[3]);
} else {
wrong_type_argument_violation(vm, "shared-bag-put!", 3, "non-negative fixnum", argv[3], argc, argv);
return scm_undef;
}
}
scm_string_t string = (scm_string_t)argv[1];
sharedbag_slot_t* slot = lookup_sharedbag((scm_sharedbag_t)argv[0], string->name, string->size);
assert(slot);
#if CYCLIC_CHECK_BEFORE_SERIALIZE
if (cyclic_objectp(vm->m_heap, argv[2])) {
serialize_cyclic_object_violation(vm, "shared-bag-put!", argv[2], argc, argv);
return scm_undef;
}
#endif
scm_obj_t obj = serializer_t(vm->m_heap).translate(argv[2]);
if (BVECTORP(obj)) {
scm_bvector_t bvector = (scm_bvector_t)obj;
int id = slot->buf.put(bvector->elts, bvector->count);
if (slot->queue.wait_lock_try_put(id)) return scm_true;
if (argc == 4) {
vm->m_interp->update(vm, VM_STATE_BLOCK);
bool succ = slot->queue.put(id, timeout);
vm->m_interp->update(vm, VM_STATE_ACTIVE);
if (succ) return scm_true;
if (slot->queue.no_more_put()) return scm_shutdown;
return scm_timeout;
} else {
vm->m_interp->update(vm, VM_STATE_BLOCK);
bool succ = slot->queue.put(id);
vm->m_interp->update(vm, VM_STATE_ACTIVE);
return succ ? scm_true : scm_shutdown;
}
}
non_serializable_object_violation(vm, "shared-bag-put!", obj, argc, argv);
return scm_undef;
}
wrong_type_argument_violation(vm, "shared-bag-put!", 1, "string", argv[1], argc, argv);
return scm_undef;
}
wrong_type_argument_violation(vm, "shared-bag-put!", 0, "shared bag", argv[0], argc, argv);
return scm_undef;
}
wrong_number_of_arguments_violation(vm, "shared-bag-put!", 3, 4, argc, argv);
return scm_undef;
#else
fatal("%s:%u shared-bag-put! not supported on this build", __FILE__, __LINE__);
#endif
}
PRIVATE OBJ strSearchBody(VMSTATE vms, VECTOR argvec, int case_matters) {
OBJ str = ARG(0);
OBJ pat = ARG(1);
uint8_t const *pos;
TYPEERRIF(!BVECTORP(str) || !BVECTORP(pat));
if (case_matters)
pos = strSearchAux(((BVECTOR) str)->vec, str->length,
((BVECTOR) pat)->vec, pat->length);
else
pos = strSearchAuxCI(((BVECTOR) str)->vec, str->length,
((BVECTOR) pat)->vec, pat->length);
if (pos == NULL)
return false;
else
return MKNUM(pos - ((BVECTOR) str)->vec);
}
PRIVATE BVECTOR getPrintString_body(VMSTATE vms, OBJ x, int depth) {
char buf[80];
if (x == NULL)
return newstring("null");
if (NUMP(x)) {
sprintf(buf, "%ld", (long) NUM(x));
return newstring(buf);
}
if (SINGLETONP(x)) {
if (x == true) return newstring("true");
if (x == false) return newstring("false");
if (x == undefined) return newstring("undefined");
return newstring("#<unknown-singleton>");
}
if (OBJECTP(x))
return newstring("#<object>");
if (BVECTORP(x))
return (BVECTOR) x;
if (OVECTORP(x)) {
OVECTOR ov = (OVECTOR) x;
switch (ov->type) {
case T_HASHTABLE: return newstring("#<hashtable>");
case T_SLOT: return newstring("#<slot>");
case T_METHOD: return newstring("#<method>");
case T_CLOSURE: return newstring("#<closure>");
case T_SYMBOL: return (BVECTOR) AT(ov, SY_NAME);
case T_PRIM: return bvector_concat(newstring("#<prim "),
bvector_concat((BVECTOR) AT((OVECTOR) AT(ov, PR_NAME),
SY_NAME),
newstring(">")));
case T_FRAME: return newstring("#<frame>");
case T_VMREGS: return newstring("#<vmregs>");
case T_CONNECTION: return newstring("#<connection>");
case T_CONTINUATION: return newstring("#<continuation>");
case T_USERHASHLINK: return newstring("#<hashlink>");
default: return newstring("#<unknown-ovector-type>");
}
}
if (VECTORP(x)) {
if (depth < 5) {
VECTOR v = (VECTOR) x;
BVECTOR result = newstring("[");
int i;
for (i = 0; i < (int) x->length - 1; i++) {
result = bvector_concat(result, getPrintString_body(vms, AT(v, i), depth + 1));
result = bvector_concat(result, newstring(", "));
}
if (x->length > 0)
result = bvector_concat(result, getPrintString_body(vms, AT(v, x->length - 1), depth + 1));
return bvector_concat(result, newstring("]"));
} else
return newstring("[...]");
}
return newstring("unhandled-type-getPrintString");
}
// shared-queue-push!
scm_obj_t
subr_shared_queue_push(VM* vm, int argc, scm_obj_t argv[])
{
#if USE_PARALLEL_VM
if (argc == 2 || argc == 3) {
if (SHAREDQUEUEP(argv[0])) {
int timeout = 0;
if (argc == 3) {
if (FIXNUMP(argv[2]) && FIXNUM(argv[2]) >= 0) {
timeout = FIXNUM(argv[2]);
} else {
wrong_type_argument_violation(vm, "shared-queue-push!", 2, "non-negative fixnum", argv[2], argc, argv);
return scm_undef;
}
}
scm_sharedqueue_t queue = (scm_sharedqueue_t)argv[0];
intptr_t id;
#if USE_SHARED_QUEUE_QUICK_ENCODE
if (FIXNUMP(argv[1])) {
id = FIXNUM(argv[1]) | INTPTR_MIN;
}
else if (argv[1] == scm_true) {
id = INTPTR_MAX;
}
else if (argv[1] == scm_false) {
id = INTPTR_MAX - 1;
}
else
#endif
{
#if CYCLIC_CHECK_BEFORE_SERIALIZE
if (cyclic_objectp(vm->m_heap, argv[1])) {
serialize_cyclic_object_violation(vm, "shared-queue-push!", argv[1], argc, argv);
return scm_undef;
}
#endif
scm_obj_t obj = serializer_t(vm->m_heap).translate(argv[1]);
if (BVECTORP(obj)) {
scm_bvector_t bvector = (scm_bvector_t)obj;
id = queue->buf.put(bvector->elts, bvector->count);
} else {
non_serializable_object_violation(vm, "shared-queue-push!", obj, argc, argv);
return scm_undef;
}
}
if (queue->queue.wait_lock_try_put(id)) return scm_true;
if (argc == 3) {
vm->m_interp->update(vm, VM_STATE_BLOCK);
bool succ = queue->queue.put(id, timeout);
vm->m_interp->update(vm, VM_STATE_ACTIVE);
if (succ) return scm_true;
if (queue->queue.no_more_put()) return scm_shutdown;
return scm_timeout;
} else {
vm->m_interp->update(vm, VM_STATE_BLOCK);
bool succ = queue->queue.put(id);
vm->m_interp->update(vm, VM_STATE_ACTIVE);
return succ ? scm_true : scm_shutdown;
}
}
wrong_type_argument_violation(vm, "shared-queue-push!", 0, "shared queue", argv[0], argc, argv);
return scm_undef;
}
wrong_number_of_arguments_violation(vm, "shared-queue-push!", 2, 3, argc, argv);
return scm_undef;
#else
fatal("%s:%u shared-queue-push! not supported on this build", __FILE__, __LINE__);
#endif
}
PUBLIC int run_vm(VMSTATE vms) {
OBJ vm_hold; /* Holding register. NOT SEEN BY GC */
int ticks_left = VM_TIMESLICE_TICKS;
while (vms->c.vm_state != VM_STATE_DYING && ticks_left-- && vms->r->vm_acc != yield_thread) {
if (vms->c.vm_state > 0) {
vms->c.vm_state--;
if (vms->c.vm_state == 0) {
/* Quota expired. Warn. */
vms->c.vm_state = VM_DEFAULT_CPU_QUOTA;
vm_raise(vms, (OBJ) newsym("quota-expired"), NULL);
/* Make sure we don't recurse :-) */
vms->r->vm_trap_closure = NULL;
}
}
gc_reach_safepoint();
#ifdef DEBUG
debug_dump_instr( vms->r->vm_code->vec , vms->c.vm_ip );
#endif
switch (CODEAT(vms->c.vm_ip)) {
case OP_AT: {
int index = CODEAT(vms->c.vm_ip + 1);
if (index < 0 || index >= vms->r->vm_acc->length) {
vm_raise(vms, (OBJ) newsym("range-check-error"), vms->r->vm_acc);
break;
}
if (!VECTORP(vms->r->vm_acc)) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
}
vms->r->vm_acc = AT((VECTOR) vms->r->vm_acc, index);
vms->c.vm_ip += 2;
break;
}
case OP_ATPUT: {
int index = CODEAT(vms->c.vm_ip + 1);
vm_hold = PEEK();
if (index < 0 || index >= vm_hold->length) {
vm_raise(vms, (OBJ) newsym("range-check-error"), vm_hold);
break;
}
if (!VECTORP(vm_hold)) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vm_hold);
break;
}
ATPUT((VECTOR) vm_hold, index, vms->r->vm_acc);
vms->c.vm_ip += 2;
break;
}
case OP_MOV_A_LOCL: {
int i = CODEAT(vms->c.vm_ip + 1);
vm_hold = (OBJ) vms->r->vm_env;
while (i-- > 0) vm_hold = AT((VECTOR) vm_hold, 0);
vms->r->vm_acc = AT((VECTOR) vm_hold, CODEAT(vms->c.vm_ip + 2) + 1);
vms->c.vm_ip += 3;
break;
}
case OP_MOV_A_GLOB:
vm_hold = AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
vms->r->vm_acc = AT((OVECTOR) vm_hold, SY_VALUE);
vms->c.vm_ip += 2;
break;
case OP_MOV_A_SLOT: {
OVECTOR slot, slotname;
if (!OBJECTP(vms->r->vm_acc)) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
}
slotname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
if (!O_CAN_X((OBJECT) vms->r->vm_acc, vms->r->vm_effuid)) {
NOPERMISSION((OBJ) slotname);
}
slot = findslot((OBJECT) vms->r->vm_acc, slotname, NULL);
if (slot == NULL) {
vm_raise(vms, (OBJ) newsym("slot-not-found"), (OBJ) slotname);
break;
}
if (!MS_CAN_R(slot, vms->r->vm_effuid)) {
NOPERMISSION((OBJ) slotname);
}
vms->r->vm_acc = AT(slot, SL_VALUE);
vms->c.vm_ip += 2;
break;
}
case OP_MOV_A_LITL:
vms->r->vm_acc = AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
vms->c.vm_ip += 2;
break;
case OP_MOV_A_SELF: vms->r->vm_acc = (OBJ) vms->r->vm_self; vms->c.vm_ip++; break;
case OP_MOV_A_FRAM: vms->r->vm_acc = (OBJ) vms->r->vm_frame; vms->c.vm_ip++; break;
case OP_MOV_LOCL_A: {
int i = CODEAT(vms->c.vm_ip + 1);
vm_hold = (OBJ) vms->r->vm_env;
while (i-- > 0) vm_hold = AT((VECTOR) vm_hold, 0);
ATPUT((VECTOR) vm_hold, CODEAT(vms->c.vm_ip + 2) + 1, vms->r->vm_acc);
vms->c.vm_ip += 3;
break;
}
case OP_MOV_GLOB_A:
if (!PRIVILEGEDP(vms->r->vm_effuid)) {
NOPERMISSION((OBJ) newsym("setting-global-value"));
}
vm_hold = AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
ATPUT((OVECTOR) vm_hold, SY_VALUE, vms->r->vm_acc);
vms->c.vm_ip += 2;
break;
case OP_MOV_SLOT_A: {
OVECTOR slot, slotname;
OBJECT target = (OBJECT) POP();
OBJECT foundin;
if (!OBJECTP(target)) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), (OBJ) target);
break;
}
slotname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
if (!O_CAN_X(target, vms->r->vm_effuid)) {
NOPERMISSION((OBJ) slotname);
}
slot = findslot(target, slotname, &foundin);
if (slot == NULL) {
vm_raise(vms, (OBJ) newsym("slot-not-found"), (OBJ) slotname);
break;
}
if (!MS_CAN_W(slot, vms->r->vm_effuid)) {
NOPERMISSION((OBJ) slotname);
}
if (foundin == target) {
ATPUT(slot, SL_VALUE, vms->r->vm_acc);
} else {
OVECTOR newslot = addslot(target, slotname, (OBJECT) AT(slot, SL_OWNER));
ATPUT(newslot, SL_FLAGS, AT(slot, SL_FLAGS));
ATPUT(newslot, SL_VALUE, vms->r->vm_acc);
}
vms->c.vm_ip += 2;
break;
}
case OP_MOV_FRAM_A:
if (!PRIVILEGEDP(vms->r->vm_effuid)) {
NOPERMISSION((OBJ) newsym("restoring-vm-frame-pointer"));
}
if (!OVECTORP(vms->r->vm_acc) || ((OVECTOR) vms->r->vm_acc)->type != T_FRAME) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
}
vms->r->vm_frame = (OVECTOR) vms->r->vm_acc;
vms->c.vm_ip++;
break;
case OP_PUSH: PUSH(vms->r->vm_acc); vms->c.vm_ip++; break;
case OP_POP: vms->r->vm_acc = POP(); vms->c.vm_ip++; break;
case OP_SWAP:
vm_hold = POP();
PUSH(vms->r->vm_acc);
vms->r->vm_acc = vm_hold;
vms->c.vm_ip++;
break;
case OP_VECTOR:
vms->r->vm_acc = (OBJ) newvector(CODEAT(vms->c.vm_ip+1));
vms->c.vm_ip += 2;
break;
case OP_ENTER_SCOPE:
vm_hold = (OBJ) newvector(CODEAT(vms->c.vm_ip+1) + 1);
ATPUT((VECTOR) vm_hold, 0, (OBJ) vms->r->vm_env);
vms->r->vm_env = (VECTOR) vm_hold;
vms->c.vm_ip += 2;
break;
case OP_LEAVE_SCOPE:
vms->r->vm_env = (VECTOR) AT(vms->r->vm_env, 0);
vms->c.vm_ip++;
break;
case OP_MAKE_VECTOR: {
int i = 0;
int len = CODEAT(vms->c.vm_ip+1);
VECTOR vec = newvector_noinit(len);
for (i = len - 1; i >= 0; i--)
ATPUT(vec, i, POP());
vms->r->vm_acc = (OBJ) vec;
vms->c.vm_ip += 2;
break;
}
case OP_CLOSURE:
vms->r->vm_acc = make_closure_from((OVECTOR) vms->r->vm_acc,
vms->r->vm_self,
vms->r->vm_env,
vms->r->vm_effuid);
vms->c.vm_ip++;
break;
case OP_METHOD_CLOSURE: {
OVECTOR methname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
OVECTOR method;
if (!OBJECTP(vms->r->vm_acc)) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
}
method = findmethod((OBJECT) vms->r->vm_acc, methname);
if (method == NULL) {
vm_raise(vms, (OBJ) newsym("method-not-found"), (OBJ) methname);
break;
}
if (!MS_CAN_R(method, vms->r->vm_effuid)) {
NOPERMISSION((OBJ) methname);
}
vm_hold = (OBJ) newovector(CL_MAXSLOTINDEX, T_CLOSURE);
ATPUT((OVECTOR) vm_hold, CL_METHOD, (OBJ) method);
ATPUT((OVECTOR) vm_hold, CL_SELF, vms->r->vm_acc);
vms->r->vm_acc = vm_hold;
vms->c.vm_ip += 2;
break;
}
case OP_RET:
if (vms->r->vm_frame != NULL) {
restoreframe(vms, vms->r->vm_frame);
if (vms->r->vm_code != NULL)
break;
}
vms->c.vm_state = VM_STATE_DYING;
return 1; /* finished, nothing more to run! */
case OP_CALL: {
OVECTOR methname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
OVECTOR method;
if (vms->r->vm_acc == NULL || TAGGEDP(vms->r->vm_acc)) {
vm_raise(vms,
(OBJ) newsym("null-call-error"),
AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip+1)));
break;
}
if (!OBJECTP(vms->r->vm_acc)) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
}
method = findmethod((OBJECT) vms->r->vm_acc, methname);
if (method == NULL) {
vm_raise(vms, (OBJ) newsym("method-not-found"), (OBJ) methname);
break;
}
if (!MS_CAN_X(method, vms->r->vm_effuid)) {
NOPERMISSION((OBJ) methname);
}
vm_hold = POP();
if (vm_hold->length-1 != NUM(AT(method, ME_ARGC))) {
vm_raise(vms, (OBJ) newsym("wrong-argc"), (OBJ) methname);
break;
}
vms->c.vm_ip += 2;
push_frame(vms);
vms->r->vm_env = (VECTOR) vm_hold;
ATPUT(vms->r->vm_env, 0, AT(method, ME_ENV));
vms->r->vm_code = (BVECTOR) AT(method, ME_CODE);
vms->r->vm_lits = (VECTOR) AT(method, ME_LITS);
vms->r->vm_self = (OBJECT) vms->r->vm_acc;
if (NUM(AT(method, ME_FLAGS)) & O_SETUID)
vms->r->vm_effuid = (OBJECT) AT(method, ME_OWNER);
vms->r->vm_method = method;
vms->c.vm_ip = 0;
break;
}
case OP_CALL_AS: {
OVECTOR methname = (OVECTOR) AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip + 1));
OVECTOR method;
if (vms->r->vm_self == NULL ||
vms->r->vm_acc == NULL || TAGGEDP(vms->r->vm_acc)) {
vm_raise(vms,
(OBJ) newsym("null-call-error"),
AT(vms->r->vm_lits, CODEAT(vms->c.vm_ip+1)));
break;
}
if (!OBJECTP(vms->r->vm_acc)) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
}
method = findmethod((OBJECT) vms->r->vm_acc, methname);
if (method == NULL) {
vm_raise(vms, (OBJ) newsym("method-not-found"), (OBJ) methname);
break;
}
if (!MS_CAN_X(method, vms->r->vm_effuid)) {
NOPERMISSION((OBJ) methname);
}
vm_hold = POP();
if (vm_hold->length-1 != NUM(AT(method, ME_ARGC))) {
vm_raise(vms, (OBJ) newsym("wrong-argc"), (OBJ) methname);
break;
}
vms->c.vm_ip += 2;
push_frame(vms);
vms->r->vm_env = (VECTOR) vm_hold;
ATPUT(vms->r->vm_env, 0, AT(method, ME_ENV));
vms->r->vm_code = (BVECTOR) AT(method, ME_CODE);
vms->r->vm_lits = (VECTOR) AT(method, ME_LITS);
/* don't set vm_self, this is OP_CALL_AS. */
/* vms->r->vm_self = vms->r->vm_acc; */
if (NUM(AT(method, ME_FLAGS)) & O_SETUID)
vms->r->vm_effuid = (OBJECT) AT(method, ME_OWNER);
vms->r->vm_method = method;
vms->c.vm_ip = 0;
break;
}
case OP_APPLY:
vms->c.vm_ip++;
apply_closure(vms, (OVECTOR) vms->r->vm_acc, (VECTOR) POP());
break;
case OP_JUMP: vms->c.vm_ip += 3 + ((int16_t) CODE16AT(vms->c.vm_ip+1)); break;
case OP_JUMP_TRUE:
vms->c.vm_ip += (vms->r->vm_acc == false) ? 3 :
3 + ((int16_t) CODE16AT(vms->c.vm_ip+1));
break;
case OP_JUMP_FALSE:
vms->c.vm_ip += (vms->r->vm_acc != false) ? 3 :
3 + ((int16_t) CODE16AT(vms->c.vm_ip+1));
break;
case OP_NOT:
vms->r->vm_acc = (vms->r->vm_acc == false) ? true : false;
vms->c.vm_ip++;
break;
case OP_EQ:
vms->r->vm_acc = (vms->r->vm_acc == POP()) ? true : false;
vms->c.vm_ip++;
break;
case OP_NE:
vms->r->vm_acc = (vms->r->vm_acc != POP()) ? true : false;
vms->c.vm_ip++;
break;
NUMOP(OP_GT, vms->r->vm_acc = (NUM(vms->r->vm_acc) < NUM(POP())) ? true : false);
NUMOP(OP_LT, vms->r->vm_acc = (NUM(vms->r->vm_acc) > NUM(POP())) ? true : false);
NUMOP(OP_GE, vms->r->vm_acc = (NUM(vms->r->vm_acc) <= NUM(POP())) ? true : false);
NUMOP(OP_LE, vms->r->vm_acc = (NUM(vms->r->vm_acc) >= NUM(POP())) ? true : false);
NUMOP(OP_NEG, vms->r->vm_acc = MKNUM(-NUM(vms->r->vm_acc)));
NUMOP(OP_BNOT, vms->r->vm_acc = MKNUM(~NUM(vms->r->vm_acc)));
NUMOP(OP_BOR, vms->r->vm_acc = MKNUM(NUM(vms->r->vm_acc)|NUM(POP())));
NUMOP(OP_BAND, vms->r->vm_acc = MKNUM(NUM(vms->r->vm_acc)&NUM(POP())));
case OP_PLUS:
if (vms->r->vm_acc == NULL || PEEK() == NULL) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
}
if (NUMP(vms->r->vm_acc) && NUMP(PEEK()))
vms->r->vm_acc = MKNUM(NUM(vms->r->vm_acc)+NUM(POP()));
else if (TAGGEDP(vms->r->vm_acc) || TAGGEDP(PEEK())) {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
} else if (BVECTORP(vms->r->vm_acc) && BVECTORP(PEEK()))
vms->r->vm_acc = (OBJ) bvector_concat((BVECTOR) POP(), (BVECTOR) vms->r->vm_acc);
else if (VECTORP(vms->r->vm_acc) && VECTORP(PEEK()))
vms->r->vm_acc = (OBJ) vector_concat((VECTOR) POP(), (VECTOR) vms->r->vm_acc);
else {
vm_raise(vms, (OBJ) newsym("vm-runtime-type-error"), vms->r->vm_acc);
break;
}
vms->c.vm_ip++;
break;
NUMOP(OP_MINUS, vms->r->vm_acc = MKNUM(NUM(POP())-NUM(vms->r->vm_acc)));
NUMOP(OP_STAR, vms->r->vm_acc = MKNUM(NUM(POP())*NUM(vms->r->vm_acc)));
NUMOP(OP_SLASH,
if (vms->r->vm_acc == MKNUM(0))
vm_raise(vms, (OBJ) newsym("divide-by-zero"), NULL);
else
vms->r->vm_acc = MKNUM(NUM(POP())/NUM(vms->r->vm_acc)));
NUMOP(OP_PERCENT,
if (vms->r->vm_acc == MKNUM(0))
vm_raise(vms, (OBJ) newsym("divide-by-zero"), NULL);
else
vms->r->vm_acc = MKNUM(NUM(POP())%NUM(vms->r->vm_acc)));
default:
fprintf(stderr, "Unknown bytecode reached (%d == 0x%x).\n",
CODEAT(vms->c.vm_ip),
CODEAT(vms->c.vm_ip));
exit(MOVE_EXIT_PROGRAMMER_FUCKUP);
}
}
return vms->c.vm_state == VM_STATE_DYING;
}
