static Value _evalCall (Procedure self, Exp a, Exp b) {
Value at = NULL, me = NULL;
if (a->type == MEMBER_EXP) {
at = _EVAL(a->u.binary->a);
me = Value_get(at, _EVAL(a->u.binary->b));
} else if ((a->type == AT_EXP || a->type == ME_EXP) && a->u.unary) {
at = a->type == AT_EXP ? self->at : self->me;
me = Value_get(at, _EVAL(a->u.unary));
} else {
me = _EVAL(a);
}
return _evalFunction(self, at, me, b);
}
VALUE VM_run(STATE)
{
Debugger_load_current_file(state);
int *ip = CURR_FRAME->fn->code;
while(1) {
switch(*ip) {
case NOOP:
break;
case SETLINE: { // debugging
ip++;
Debugger_setline(state, *ip);
break;
}
case PUSH: {
Debugger_evaluate(state);
ip++;
debugi("PUSH %i", *ip);
VALUE value = LITERAL(*ip);
Stack_push(STACK, value);
break;
}
case PUSHTRUE: {
Debugger_evaluate(state);
debugi("PUSHTRUE");
Stack_push(STACK, TrueObject);
break;
}
case PUSHFALSE: {
Debugger_evaluate(state);
debugi("PUSHFALSE");
Stack_push(STACK, FalseObject);
break;
}
case PUSHNIL: {
Debugger_evaluate(state);
debugi("PUSHNIL");
Stack_push(STACK, NilObject);
break;
}
case JMP: {
Debugger_evaluate(state);
ip++;
int jump = *ip;
debugi("JMP %i", jump);
while(jump--) ip++;
break;
}
case JIF: {
Debugger_evaluate(state);
ip++;
int jump = *ip;
debugi("JIF %i", jump);
VALUE value = Stack_pop(STACK);
if (value == FalseObject || value == NilObject) {
while(jump--) ip++;
}
break;
}
case JIT: {
Debugger_evaluate(state);
ip++;
int jump = *ip;
debugi("JIT %i", jump);
VALUE value = Stack_pop(STACK);
if (value != FalseObject && value != NilObject) {
while(jump--) ip++;
}
break;
}
case GOTO: {
Debugger_evaluate(state);
ip++;
int jump = *ip - 2;
debugi("GOTO %i", jump);
ip = CURR_FRAME->fn->code;
while(jump--) ip++;
break;
}
case GETSLOT: {
Debugger_evaluate(state);
ip++;
debugi("GETSLOT %i", *ip);
VALUE receiver = Stack_pop(STACK);
VALUE slot = LITERAL(*ip);
check(receiver->type != NilType, "Tried to get a slot from nil.");
check(slot->type == StringType, "Slot name must be a String.");
VALUE value = Value_get(receiver, VAL2STR(slot));
check(value, "Undefined slot %s on object type %i.", VAL2STR(slot), receiver->type);
Stack_push(STACK, value);
break;
}
case SETSLOT: {
Debugger_evaluate(state);
ip++;
debugi("SETSLOT %i", *ip);
VALUE value = Stack_pop(STACK);
VALUE receiver = Stack_pop(STACK);
VALUE slot = LITERAL(*ip);
check(receiver->type != NilType, "Tried to set a slot on nil.");
check(slot->type == StringType, "Slot name must be a String.");
Value_set(state, receiver, VAL2STR(slot), value);
Stack_push(STACK, value); // push the rhs back to the stack
break;
}
case DEFN: {
Debugger_evaluate(state);
ip++;
debugi("DEFN %i", *ip);
VALUE fn_name = LITERAL(*ip);
bstring state_fn = bfromcstr(VAL2STR(fn_name));
VALUE closure = Closure_new(state, STATE_FN(state_fn), CURR_FRAME);
bdestroy(state_fn);
Stack_push(STACK, closure);
break;
}
case MAKEVEC: {
Debugger_evaluate(state);
ip++;
debugi("MAKEVEC %i", *ip);
int count = *ip;
DArray *array = DArray_create(sizeof(VALUE), count || 1);
while(count--) {
VALUE elem = Stack_pop(STACK);
check(elem, "Stack underflow.");
GC_protect(elem);
DArray_push(array, elem);
}
VALUE vector = Vector_new(state, array);
Stack_push(STACK, vector);
Vector_each(vector, ^ void (VALUE element) {
GC_unprotect(element);
});
break;
}
case SEND: {
Debugger_evaluate(state);
ip++;
int op1 = *ip;
ip++;
int op2 = *ip;
debugi("SEND %i %i", op1, op2);
VALUE name = LITERAL(op1);
int argcount = op2;
DArray *locals = DArray_create(sizeof(VALUE), argcount+1);
while(argcount--) {
DArray_push(locals, Stack_pop(STACK));
}
VALUE receiver = Stack_pop(STACK);
// Special chicken-egg case. We cannot define "apply" as a native method
// on Closure, since that triggers the creation of a new closure ad
// infinitum, so we have to handle this special function here.
if(receiver->type == ClosureType &&
strcmp(VAL2STR(name), "apply") == 0) {
state->ret = ip; // save where we want to return
ip = Function_call(state, VAL2FN(receiver), CURR_FRAME->self, locals, VAL2STR(name));
break;
}
VALUE closure = Value_get(receiver, VAL2STR(name));
check(closure, "Undefined slot %s on object type %i.", VAL2STR(name), receiver->type);
if (closure->type != ClosureType && closure != NilObject) {
// GETSLOT
Stack_push(STACK, closure);
DArray_destroy(locals);
break;
}
#ifdef OPTIMIZE_SEND
if(op2 == 1 && strcmp(VAL2STR(name), "[]") == 0) { // getslot
VALUE key = (VALUE)DArray_at(locals, 0);
Stack_push(STACK, Value_get(receiver, VAL2STR(key)));
DArray_destroy(locals);
break;
}
if(op2 == 2 && strcmp(VAL2STR(name), "[]=") == 0) { // setslot
VALUE key = (VALUE)DArray_at(locals, 0);
VALUE value = (VALUE)DArray_at(locals, 1);
Value_set(receiver, VAL2STR(key), value);
Stack_push(STACK, value);
DArray_destroy(locals);
break;
}
#endif
state->ret = ip; // save where we want to return
ip = Function_call(state, VAL2FN(closure), receiver, locals, VAL2STR(name));
break;
}
case PUSHLOBBY: {
Debugger_evaluate(state);
debugi("PUSHLOBBY");
Stack_push(STACK, state->lobby);
break;
}
case PUSHSELF: {
Debugger_evaluate(state);
debugi("PUSHSELF");
Stack_push(STACK, CURR_FRAME->self);
break;
}
case PUSHLOCAL: {
Debugger_evaluate(state);
ip++;
Stack_push(STACK, LOCAL(*ip));
debugi("PUSHLOCAL %i", *ip);
break;
}
case PUSHLOCALDEPTH: {
Debugger_evaluate(state);
ip++;
int depth = *ip;
ip++;
Stack_push(STACK, DEEPLOCAL(depth, *ip));
debugi("PUSHLOCALDEPTH %i %i", depth, *ip);
break;
}
case SETLOCAL: {
Debugger_evaluate(state);
ip++;
debugi("SETLOCAL %i", *ip);
LOCALSET(*ip, Stack_peek(STACK));
break;
}
case SETLOCALDEPTH: {
Debugger_evaluate(state);
ip++;
int depth = *ip;
ip++;
debugi("SETLOCAL %i %i", depth, *ip);
DEEPLOCALSET(depth, *ip, Stack_peek(STACK));
break;
}
case POP: {
Debugger_evaluate(state);
ip++;
int count = *ip;
debugi("POP %i", count);
check(Stack_count(STACK) >= count, "Stack underflow.");
while(count--) Stack_pop(STACK);
break;
}
case RET: {
Debugger_evaluate(state);
debugi("RET");
CallFrame *old_frame = Stack_pop(FRAMES);
ip = old_frame->ret;
CallFrame_destroy(old_frame);
check(Stack_count(STACK) > 0, "Stack underflow.");
if (ip == NULL) return Stack_pop(STACK); // if there's nowhere to return, exit
break;
}
case DUMP: {
Debugger_evaluate(state);
debugi("DUMP");
Stack_print(state, STACK);
DArray *literals = CURR_FRAME->fn->literals;
printf("--LITERALS (%i)--\n", DArray_count(literals));
Value_print_all(state, literals);
DArray *locals = CURR_FRAME->locals;
printf("--LOCALS (%i)--\n", DArray_count(locals));
Value_print_all(state, locals);
break;
}
}
// ================================================================================================
// Procedure_eval
// ================================================================================================
Value Procedure_eval (Procedure self, Exp exp) {
if (!(self && exp)) return NULL;
/*
if (exp->type != COMMA_EXP) {
printf("%s: %d, %s\n", at_currentInterpreter->filePath->u.string, exp->lineno, ExpD_toString(exp));
}
*/
at_currentInterpreter->currentExp = exp;
switch (exp->type) {
case VALUE_EXP:
return exp->u.value;
case IDENTIFIER_EXP:
return _get(self, exp->u.value);
case OBJECT_EXP:
return _evalTrue(self, exp->u.unary);
case ABS_EXP:case MINUS_EXP:
return _evalAbs(self, exp->type, exp->u.unary);
case NOT_EXP:
return _EVAL(exp->u.unary) ? NULL : at_True;
case RETURN_EXP:case RETURN_IF_EXP:case RETURN_UNLESS_EXP:
case BREAK_EXP:case BREAK_IF_EXP:case BREAK_UNLESS_EXP:
case CONTINUE_EXP:case CONTINUE_IF_EXP:case CONTINUE_UNLESS_EXP:
return _evalBreak(self, exp->type, exp->u.unary);
case AND_EXP:case OR_EXP:
case EQ_EXP:case NE_EXP:case GT_EXP:case GE_EXP:case LT_EXP:case LE_EXP:
case CAT_EXP:case ADD_EXP:case SUB_EXP:case MUL_EXP:case DIV_EXP:
return _evalMath(self, exp->type, exp->u.binary->a, exp->u.binary->b);
case ASSIGN_EXP:
//printf("debug: %s\n", ExpD_toString(exp));
return _evalAssign(self, exp->u.binary->a, _EVAL(exp->u.binary->b));
case AND_ASSIGN_EXP:case OR_ASSIGN_EXP:
case EQ_ASSIGN_EXP:case NE_ASSIGN_EXP:
case GT_ASSIGN_EXP:case GE_ASSIGN_EXP:case LT_ASSIGN_EXP:case LE_ASSIGN_EXP:
case CAT_ASSIGN_EXP:case ADD_ASSIGN_EXP:case SUB_ASSIGN_EXP:case MUL_ASSIGN_EXP:case DIV_ASSIGN_EXP:
//printf("debug: %s\n", ExpD_toString(exp));
return _evalAssign(self, exp->u.binary->a,
_evalMath(self, ExpType_assign2(exp->type), exp->u.binary->a, exp->u.binary->b));
case REQUIRE_EXP:
return _evalRequire(_EVAL(exp->u.unary));
case AT_EXP:
if (!exp->u.unary) return self->at;
return Value_get(self->at, _EVAL(exp->u.unary));
case ME_EXP:
if (!exp->u.unary) return self->me;
return Value_get(self->me, _EVAL(exp->u.unary));
case MEMBER_EXP:
return Value_get(_EVAL(exp->u.binary->a), _EVAL(exp->u.binary->b));
case CALL_EXP:
return _evalCall(self, exp->u.binary->a, exp->u.binary->b);
case COMMA_EXP:
return _evalComma(self, exp->u.binary->a, exp->u.binary->b);
case CASE_EXP:
yyerror("syntax error: unexpected case operator.");
return NULL;
case COLON_EXP:
yyerror("syntax error: unexpected colon operator.");
return NULL;
case TO_EXP:case LESS_TO_EXP:
return _evalTo(self, exp->type, exp->u.ternary->a, exp->u.ternary->b, exp->u.ternary->c);
case ACCESSOR_EXP:
//printf("debug: %s\n", ExpD_toString(exp));
return _evalAssign(self, exp->u.binary->a, Value_functionAccessor(self, exp->u.binary->b));
case FUNCTION_EXP:
return Value_function(self, exp);
case WHILE_EXP:case UNTIL_EXP:
return _evalWhile(Procedure_new(self, self->assoc, self->at, self->me, exp));
case IN_EXP:case IN_OWN_EXP:
return _evalForeach(Procedure_new(self, self->assoc, self->at, self->me, exp));
case IF_EXP:
return _EVAL(_EVAL(exp->u.ternary->a) ? exp->u.ternary->b : exp->u.ternary->c);
case SWITCH_EXP:
return _evalSwitch(self, exp->u.ternary->a, exp->u.ternary->b, exp->u.ternary->c);
default:
yyerror("syntax error: unknown expression");
return NULL;
}
}
