static void
execute(MVM_VirtualMachine *mvm, Function *func,
MVM_Byte *code, int code_size)
{
int base;
MVM_Executable *exe;
int pc;
//MVM_Value ret;
pc = mvm->pc;
exe = mvm->current_executable;
while (pc < code_size) {
/*printf("%s sp(%d)\t\n",
mvm_opcode_info[code[pc]].mnemonic,
mvm->stack.stack_pointer);*/
switch (code[pc]) {
case MVM_PUSH_INT_1BYTE:
STI_WRITE(mvm, 0, code[pc+1]);
//printf("int byte %d\n",code[pc+1]);
mvm->stack.stack_pointer++;
pc += 2;
break;
case MVM_PUSH_INT_2BYTE:
STI_WRITE(mvm, 0, GET_2BYTE_INT(&code[pc+1]));
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_PUSH_INT:
STI_WRITE(mvm, 0,
exe->constant_pool[GET_2BYTE_INT(&code[pc+1])].u.c_integer);
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_PUSH_DOUBLE_0:
STD_WRITE(mvm, 0, 0.0);
mvm->stack.stack_pointer++;
pc++;
break;
case MVM_PUSH_DOUBLE_1:
STD_WRITE(mvm, 0, 1.0);
mvm->stack.stack_pointer++;
pc++;
break;
case MVM_PUSH_DOUBLE:
STD_WRITE(mvm, 0,
exe->constant_pool[GET_2BYTE_INT(&code[pc+1])].u.c_decimal);
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_PUSH_STRING:
STO_WRITE(mvm, 0,
mvm_literal_to_mvm_string_i(mvm,
exe->constant_pool
[GET_2BYTE_INT(&code
[pc+1])]
.u.c_string));
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_PUSH_NULL:
STO_WRITE(mvm, 0, NULL);
mvm->stack.stack_pointer++;
pc++;
break;
case MVM_PUSH_STACK_INT:
STI_WRITE(mvm, 0,
STI_I(mvm, base + GET_2BYTE_INT(&code[pc+1])));
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_PUSH_STACK_DOUBLE:
STD_WRITE(mvm, 0,
STD_I(mvm, base + GET_2BYTE_INT(&code[pc+1])));
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_PUSH_STACK_OBJECT:
STO_WRITE(mvm, 0,
STO_I(mvm, base + GET_2BYTE_INT(&code[pc+1])));
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_POP_STACK_INT:
STI_WRITE_I(mvm, base + GET_2BYTE_INT(&code[pc+1]),
STI(mvm, -1));
mvm->stack.stack_pointer--;
pc += 3;
break;
case MVM_POP_STACK_DOUBLE:
STD_WRITE_I(mvm, base + GET_2BYTE_INT(&code[pc+1]),
STD(mvm, -1));
mvm->stack.stack_pointer--;
pc += 3;
break;
case MVM_POP_STACK_OBJECT:
STO_WRITE_I(mvm, base + GET_2BYTE_INT(&code[pc+1]),
STO(mvm, -1));
mvm->stack.stack_pointer--;
pc += 3;
break;
case MVM_PUSH_STATIC_INT:
STI_WRITE(mvm, 0,
mvm->static_v.variable[GET_2BYTE_INT(&code[pc+1])]
.int_value);
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_PUSH_STATIC_DOUBLE:
STD_WRITE(mvm, 0,
mvm->static_v.variable[GET_2BYTE_INT(&code[pc+1])]
.double_value);
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_PUSH_STATIC_OBJECT:
STO_WRITE(mvm, 0,mvm->static_v.variable[GET_2BYTE_INT(&code[pc+1])].object);
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_POP_STATIC_INT:
mvm->static_v.variable[GET_2BYTE_INT(&code[pc+1])].int_value
= STI(mvm, -1);
mvm->stack.stack_pointer--;
pc += 3;
break;
case MVM_POP_STATIC_DOUBLE:
mvm->static_v.variable[GET_2BYTE_INT(&code[pc+1])]
.double_value
= STD(mvm, -1);
mvm->stack.stack_pointer--;
pc += 3;
break;
case MVM_POP_STATIC_OBJECT:
mvm->static_v.variable[GET_2BYTE_INT(&code[pc+1])].object
= STO(mvm, -1);
mvm->stack.stack_pointer--;
pc += 3;
break;
case MVM_PUSH_ARRAY_INT:
{
MVM_Object *array = STO(mvm, -2);
int index = STI(mvm, -1);
int int_value;
restore_pc(mvm, exe, func, pc);
int_value = MVM_array_get_int(mvm, array, index);
STI_WRITE(mvm, -2, int_value);
mvm->stack.stack_pointer--;
pc++;
break;
}
case MVM_PUSH_ARRAY_DOUBLE:
{
MVM_Object *array = STO(mvm, -2);
int index = STI(mvm, -1);
double double_value;
restore_pc(mvm, exe, func, pc);
double_value = MVM_array_get_double(mvm, array, index);
STD_WRITE(mvm, -2, double_value);
mvm->stack.stack_pointer--;
pc++;
break;
}
case MVM_PUSH_ARRAY_OBJECT:
{
MVM_Object *array = STO(mvm, -2);
int index = STI(mvm, -1);
MVM_Object *object;
restore_pc(mvm, exe, func, pc);
object = MVM_array_get_object(mvm, array, index);
STO_WRITE(mvm, -2, object);
mvm->stack.stack_pointer--;
pc++;
break;
}
case MVM_POP_ARRAY_INT:
{
int value = STI(mvm, -3);
MVM_Object *array = STO(mvm, -2);
int index = STI(mvm, -1);
restore_pc(mvm, exe, func, pc);
MVM_array_set_int(mvm, array, index, value);
mvm->stack.stack_pointer -= 3;
pc++;
break;
}
case MVM_POP_ARRAY_DOUBLE:
{
double value = STD(mvm, -3);
MVM_Object *array = STO(mvm, -2);
int index = STI(mvm, -1);
restore_pc(mvm, exe, func, pc);
MVM_array_set_double(mvm, array, index, value);
mvm->stack.stack_pointer -= 3;
pc++;
break;
}
case MVM_POP_ARRAY_OBJECT:
{
MVM_Object *value = STO(mvm, -3);
MVM_Object *array = STO(mvm, -2);
int index = STI(mvm, -1);
restore_pc(mvm, exe, func, pc);
MVM_array_set_object(mvm, array, index, value);
mvm->stack.stack_pointer -= 3;
pc++;
break;
}
case MVM_PUSH_FIELD_INT:
{
MVM_Object *obj = STO(mvm, -1);
int index = GET_2BYTE_INT(&code[pc+1]);
//check_null_pointer(exe, func, pc, obj);
STI_WRITE(mvm, -1,
obj->u.class_object.field[index].int_value);
pc += 3;
break;
}
case MVM_PUSH_FIELD_DOUBLE:
{
MVM_Object *obj = STO(mvm, -1);
int index = GET_2BYTE_INT(&code[pc+1]);
//check_null_pointer(exe, func, pc, obj);
STD_WRITE(mvm, -1,
obj->u.class_object.field[index].double_value);
pc += 3;
break;
}
case MVM_PUSH_FIELD_OBJECT:
{
MVM_Object *obj = STO(mvm, -1);
int index = GET_2BYTE_INT(&code[pc+1]);
//check_null_pointer(exe, func, pc, obj);
STO_WRITE(mvm, -1, obj->u.class_object.field[index].object);
pc += 3;
break;
}
case MVM_POP_FIELD_INT:
{
MVM_Object *obj = STO(mvm, -1);
int index = GET_2BYTE_INT(&code[pc+1]);
obj->u.class_object.field[index].int_value = STI(mvm, -2);
mvm->stack.stack_pointer -= 2;
pc += 3;
break;
}
case MVM_POP_FIELD_DOUBLE:
{
MVM_Object *obj = STO(mvm, -1);
int index = GET_2BYTE_INT(&code[pc+1]);
obj->u.class_object.field[index].double_value = STD(mvm, -2);
mvm->stack.stack_pointer -= 2;
pc += 3;
break;
}
case MVM_POP_FIELD_OBJECT:
{
MVM_Object *obj = STO(mvm, -1);
int index = GET_2BYTE_INT(&code[pc+1]);
//check_null_pointer(exe, func, pc, obj);
obj->u.class_object.field[index].object = STO(mvm, -2);
mvm->stack.stack_pointer -= 2;
pc += 3;
break;
}
case MVM_ADD_INT:
STI(mvm, -2) = STI(mvm, -2) + STI(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_ADD_DOUBLE:
STD(mvm, -2) = STD(mvm, -2) + STD(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_ADD_STRING:
STO(mvm, -2) = chain_string(mvm,
STO(mvm, -2),
STO(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_SUB_INT:
STI(mvm, -2) = STI(mvm, -2) - STI(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_SUB_DOUBLE:
STD(mvm, -2) = STD(mvm, -2) - STD(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_MUL_INT:
STI(mvm, -2) = STI(mvm, -2) * STI(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_MUL_DOUBLE:
STD(mvm, -2) = STD(mvm, -2) * STD(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_DIV_INT:
if (STI(mvm, -1) == 0) {
//mvm_error(exe, func, pc, DIVISION_BY_ZERO_ERR,
// MESSAGE_ARGUMENT_END);
}
STI(mvm, -2) = STI(mvm, -2) / STI(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_DIV_DOUBLE:
STD(mvm, -2) = STD(mvm, -2) / STD(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_MOD_INT:
STI(mvm, -2) = STI(mvm, -2) % STI(mvm, -1);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_MOD_DOUBLE:
STD(mvm, -2) = fmod(STD(mvm, -2), STD(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_MINUS_INT:
STI(mvm, -1) = -STI(mvm, -1);
pc++;
break;
case MVM_MINUS_DOUBLE:
STD(mvm, -1) = -STD(mvm, -1);
pc++;
break;
case MVM_INCREMENT:
STI(mvm, -1)++;
pc++;
break;
case MVM_DECREMENT:
STI(mvm, -1)--;
pc++;
break;
case MVM_CAST_INT_TO_DOUBLE:
STD(mvm, -1) = (double)STI(mvm, -1);
pc++;
break;
case MVM_CAST_DOUBLE_TO_INT:
STI(mvm, -1) = (int)STD(mvm, -1);
pc++;
break;
case MVM_CAST_BOOLEAN_TO_STRING:
if (STI(mvm, -1)) {
STO_WRITE(mvm, -1,
mvm_literal_to_mvm_string_i(mvm, TRUE_STRING));
} else {
STO_WRITE(mvm, -1,
mvm_literal_to_mvm_string_i(mvm, FALSE_STRING));
}
pc++;
break;
case MVM_CAST_INT_TO_STRING:
{
char buf[LINE_BUF_SIZE];
MVM_Char *str;
sprintf(buf, "%d", STI(mvm, -1));
restore_pc(mvm, exe, func, pc);
str = str_alloc(buf);
STO_WRITE(mvm, -1,
mvm_create_mvm_string_i(mvm, str));
pc++;
break;
}
case MVM_CAST_DOUBLE_TO_STRING:
{
char buf[LINE_BUF_SIZE];
MVM_Char *str;
sprintf(buf, "%f", STD(mvm, -1));
restore_pc(mvm, exe, func, pc);
str = str_alloc(buf);
STO_WRITE(mvm, -1,
mvm_create_mvm_string_i(mvm, str));
pc++;
break;
}
case MVM_EQ_INT:
STI(mvm, -2) = (STI(mvm, -2) == STI(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_EQ_DOUBLE:
STI(mvm, -2) = (STD(mvm, -2) == STD(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_EQ_OBJECT:
STI_WRITE(mvm, -2, STO(mvm, -2) == STO(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_EQ_STRING:
STI_WRITE(mvm, -2,
!strcmp(STO(mvm, -2)->u.string.string, STO(mvm, -1)->u.string.string));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_GT_INT:
STI(mvm, -2) = (STI(mvm, -2) > STI(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_GT_DOUBLE:
STI(mvm, -2) = (STD(mvm, -2) > STD(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_GT_STRING:
STI_WRITE(mvm, -2,
strcmp(STO(mvm, -2)->u.string.string,
STO(mvm, -1)->u.string.string) > 0);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_GE_INT:
STI(mvm, -2) = (STI(mvm, -2) >= STI(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_GE_DOUBLE:
STI(mvm, -2) = (STD(mvm, -2) >= STD(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_GE_STRING:
STI_WRITE(mvm, -2,
strcmp(STO(mvm, -2)->u.string.string,
STO(mvm, -1)->u.string.string) >= 0);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LT_INT:
STI(mvm, -2) = (STI(mvm, -2) < STI(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LT_DOUBLE:
STI(mvm, -2) = (STD(mvm, -2) < STD(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LT_STRING:
STI_WRITE(mvm, -2,
strcmp(STO(mvm, -2)->u.string.string,
STO(mvm, -1)->u.string.string) < 0);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LE_INT:
STI(mvm, -2) = (STI(mvm, -2) <= STI(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LE_DOUBLE:
STI(mvm, -2) = (STD(mvm, -2) <= STD(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LE_STRING:
STI_WRITE(mvm, -2,
strcmp(STO(mvm, -2)->u.string.string,
STO(mvm, -1)->u.string.string) <= 0);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_NE_INT:
STI(mvm, -2) = (STI(mvm, -2) != STI(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_NE_DOUBLE:
STI(mvm, -2) = (STD(mvm, -2) != STD(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_NE_OBJECT:
STI_WRITE(mvm, -2, STO(mvm, -2) != STO(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_NE_STRING:
STI_WRITE(mvm, -2,
strcmp(STO(mvm, -2)->u.string.string,
STO(mvm, -1)->u.string.string) != 0);
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LOGICAL_AND:
STI(mvm, -2) = (STI(mvm, -2) && STI(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LOGICAL_OR:
STI(mvm, -2) = (STI(mvm, -2) || STI(mvm, -1));
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_LOGICAL_NOT:
STI(mvm, -1) = !STI(mvm, -1);
pc++;
break;
case MVM_POP:
mvm->stack.stack_pointer--;
pc++;
break;
case MVM_DUPLICATE:
mvm->stack.stack[mvm->stack.stack_pointer]
= mvm->stack.stack[mvm->stack.stack_pointer-1];
mvm->stack.stack_pointer++;
pc++;
break;
case MVM_JUMP:
pc = GET_2BYTE_INT(&code[pc+1]);
break;
case MVM_JUMP_IF_TRUE:
if (STI(mvm, -1)) {
pc = GET_2BYTE_INT(&code[pc+1]);
} else {
pc += 3;
}
mvm->stack.stack_pointer--;
break;
case MVM_JUMP_IF_FALSE:
if (!STI(mvm, -1)) {
pc = GET_2BYTE_INT(&code[pc+1]);
} else {
pc += 3;
}
mvm->stack.stack_pointer--;
break;
case MVM_PUSH_FUNCTION:
STI_WRITE(mvm, 0, GET_2BYTE_INT(&code[pc+1]));
mvm->stack.stack_pointer++;
pc += 3;
break;
case MVM_INVOKE:
{
int func_idx = STI(mvm, -1);
if (mvm->function[func_idx].kind == NATIVE_FUNCTION) {
invoke_native_function(mvm, &mvm->function[func_idx],
&mvm->stack.stack_pointer);
pc++;
} else {
invoke_minic_function(mvm, &func, &mvm->function[func_idx],
&code, &code_size, &pc,
&mvm->stack.stack_pointer, &base,
&exe);
}
break;
}
case MVM_RETURN:
return_function(mvm, &func, &code, &code_size, &pc,
&mvm->stack.stack_pointer, &base,
&exe);
break;
case MVM_NEW_ARRAY:
{
int dim = code[pc+1];
MVM_TypeSpecifier *type
= &exe->type_specifier[GET_2BYTE_INT(&code[pc+2])];
MVM_Object *array;
restore_pc(mvm, exe, func, pc);
array = create_array(mvm, dim, type);
mvm->stack.stack_pointer -= dim;
STO_WRITE(mvm, 0, array);
mvm->stack.stack_pointer++;
pc += 4;
break;
}
case MVM_NEW_ARRAY_LITERAL_INT: /* FALLTHRU */
{
int size = GET_2BYTE_INT(&code[pc+1]);
MVM_Object *array;
restore_pc(mvm, exe, func, pc);
array = create_array_literal_int(mvm, size);
mvm->stack.stack_pointer -= size;
STO_WRITE(mvm, 0, array);
mvm->stack.stack_pointer++;
pc += 3;
break;
}
case MVM_NEW_ARRAY_LITERAL_DOUBLE: /* FALLTHRU */
{
int size = GET_2BYTE_INT(&code[pc+1]);
MVM_Object *array;
restore_pc(mvm, exe, func, pc);
array = create_array_literal_double(mvm, size);
mvm->stack.stack_pointer -= size;
STO_WRITE(mvm, 0, array);
mvm->stack.stack_pointer++;
pc += 3;
break;
}
case MVM_NEW_ARRAY_LITERAL_OBJECT: /* FALLTHRU */
{
int size = GET_2BYTE_INT(&code[pc+1]);
MVM_Object *array;
restore_pc(mvm, exe, func, pc);
array = create_array_literal_object(mvm, size);
mvm->stack.stack_pointer -= size;
STO_WRITE(mvm, 0, array);
mvm->stack.stack_pointer++;
pc += 3;
break;
}
default:
break;
}
/* MEM_check_all_blocks(); */
}
//return ret;
}
CRB_Value
crb_eval_binary_expression(CRB_Interpret *inter, LocalEnvironment *env,
ExpressionType operator,
Expression *left, Expression *right)
{
CRB_Value left_val;
CRB_Value right_val;
CRB_Value result;
left_val = eval_expression(inter, env, left);
right_val = eval_expression(inter, env, right);
if(left_val.type == CRB_INT_VALUE
&& right_val.type == CRB_INT_VALUE){
eval_binary_int(inter, operator,
left_val.u.int_value, right_val.u.int_value,
&result, letf->line_number);
} else if(left_val.type == CRB_DOUBLE_VALUE
&& right_val.type == CRB_DOUBLE_VALUE){
eval_binary_double(inter, operator,
left_val.u.double_value, right_val.u.double_value,
&result, left->line_number);
} else if(left_val.type == CRB_INT_VALUE
&& right_val.type == CRB_DOUBLE_VALUE){
right_val.u.double_value = right_val.u.int_value;
eval_binary_double(inter, operator,
left_val.u.double_value, right_val.u.double_value,
&result, left->line_number);
} else if(left_val.type == CRB_DOUBLE_VALUE
&& right_val.type == CRB_INT_VALUE){
right_val.u.double_value = right_val.u.int_value;
eval_binary_double(inter, operator,
left_val.u.double_value, right_val.u.double_value,
&result, left->line_number);
} else if(left_val.type == CRB_BOOLEAN_VALUE
&& right_val.type == CRB_BOOLEAN_VALUE){
result.type = CRB_BOOLEAN_VALUE;
result.u.boolean_value
= eval_binary_boolean(inter, operator,
left_val.u.doublean_value,
right_val.u.double_value,
left->line_number);
}else if(left_val.type == CRB_STRING_VALUE
&& operator == ADD_EXPRESSION){
char buf[LINE_BUF_SIZE];
CRB_String *right_str;
if(right_val.type == CRB_INT_VALUE){
sprintf(buf, "%d", right_val.u.int_value);
right_str = crb_create_crowbar_string(inter, MEM_strdup(buf));
} else if(right_val.tpye == CRB_DOUBLE_VALUE){
sprintf(buf, "%f", right_val.u.double_value);
right_str = crb_create_crowbar_string(inter, MEM_strdup(buf));
} else if(right_val.type == CRB_BOOLEAN_VALUE){
if(right_val.u.boolean_value){
right_str = crb_create_crowbar_str(inter,
MEM_strdup("true"));
} else {
right_str = crb_create_crowbar_string(inter,
MEM_strdup("false"));
}
}else if(right_val.type == CRB_STRING_VALUE){
right_str = right_val.u.tring_value;
} else if(right_val.type == CRB_NATIVE_POINTER_VALUE){
sprintf(buf, "%s:%p)",
right_val.u.native_pointer.info->name,
right_val.u.native_pointer.pointer);
right_str = crb_create_crowbar_string(inter, MEM_strdup(buf));
} else if(right_val.type == CRB_NULL_VALUE){
right_str = crb_create_crowbar_string(inter, MEM_strdup("null"));
}
result.type = CRB_STRING_VALUE;
result.u.string_value = chain_string(inter,
left_val.u.string_value,
right_str);
} else if(left_val.type == CRB_STRING_VALUE
&& right_val.type == CRB_STRING_VALUE){
resultr.type = CRB_BOOLEAN_VALUE;
result.u.boolean_value
= eval_compare_string(operator, &left_val, &right_val,
left->line_number);
} else if(left_val.type == CRB_NULL_VALUE
|| right_val.type == CRB_NULL_VALUE){
result.type = CRB_BOOLEAN_VALUE;
result.u.boolean_value
= eval_binary_null(inter, operator,&left_val, &right_val,
left->line_number);
} else {
char *op_str = crb_get_operator_string(operator);
crb_runtime_error(left->line_number, BAD_OPERAND_TYPE_ERR,
STRING_MESSAGE_ARGUMENT, "operator", op_str,
MESSAGE_ARGUMENT_END);
}
return result;
}
cell_t *serialize_cell(secd_t *secd, cell_t *cell) {
cell_t *opt = SECD_NIL;
switch (cell_type(cell)) {
case CELL_CONS: {
cell_t *cdrc = chain_index(secd, get_cdr(cell), SECD_NIL);
opt = chain_index(secd, get_car(cell), cdrc);
}
break;
case CELL_PORT:
opt = secd_pserialize(secd, cell);
break;
case CELL_SYM:
opt = new_cons(secd, cell, SECD_NIL);
break;
case CELL_INT:
case CELL_CHAR:
opt = new_cons(secd, cell, SECD_NIL);
break;
case CELL_OP: {
cell_t *namec = new_symbol(secd, opcode_table[ cell->as.op ].name);
opt = new_cons(secd, namec, SECD_NIL);
}
break;
case CELL_FUNC:
opt = new_cons(secd, new_number(secd, (long)cell->as.ptr), SECD_NIL);
break;
case CELL_ARRMETA: {
cell_t *typec = chain_sym(secd,
(cell->as.mcons.cells ? "cell" : "byte"),
SECD_NIL);
cell_t *nextc = chain_index(secd, mcons_next(cell), typec);
opt = chain_index(secd, mcons_prev(cell), nextc);
}
break;
case CELL_FRAME: {
cell_t *ioc = chain_index(secd, cell->as.frame.io, SECD_NIL);
cell_t *nextc = chain_index(secd, cell->as.frame.cons.cdr, ioc);
opt = chain_index(secd, cell->as.frame.cons.car, nextc);
}
break;
case CELL_KONT: {
cell_t *kctrl = chain_index(secd, cell->as.kont.ctrl, SECD_NIL);
cell_t *kenv = chain_index(secd, cell->as.kont.env, kctrl);
opt = chain_index(secd, cell->as.kont.stack, kenv);
}
break;
case CELL_FREE: {
cell_t *nextc = chain_index(secd, get_cdr(cell), SECD_NIL);
opt = chain_index(secd, get_car(cell), nextc);
}
break;
case CELL_REF:
opt = chain_index(secd, cell->as.ref, SECD_NIL);
break;
case CELL_ERROR:
opt = chain_string(secd, errmsg(cell), SECD_NIL);
break;
case CELL_UNDEF:
opt = SECD_NIL;
break;
case CELL_ARRAY:
opt = chain_index(secd, arr_val(cell, -1), SECD_NIL);
break;
case CELL_STR:
case CELL_BYTES:
opt = chain_index(secd, arr_meta((cell_t *)strmem(cell)), SECD_NIL);
break;
}
opt = new_cons(secd, secd_type_sym(secd, cell), opt);
cell_t *refc = new_cons(secd, new_number(secd, cell->nref), opt);
return new_cons(secd, new_number(secd, cell - secd->begin), refc);
}
static void
eval_binary_expression(SIMCAR_Interpreter *inter, SIMCAR_LocalEnvironment *env,
ExpressionType operato,
Expression *left, Expression *right)
{
SIMCAR_Value *left_val;
SIMCAR_Value *right_val;
SIMCAR_Value result;
eval_expression(inter, env, left);
eval_expression(inter, env, right);
left_val = peek_stack(inter, 1);
right_val = peek_stack(inter, 0);
if (left_val->type == SIMCAR_INT_VALUE
&& right_val->type == SIMCAR_INT_VALUE) {
eval_binary_int(inter, operato,
left_val->u.int_value, right_val->u.int_value,
&result, left->line_number);
} else if (left_val->type == SIMCAR_DOUBLE_VALUE
&& right_val->type == SIMCAR_DOUBLE_VALUE) {
eval_binary_double(inter, operato,
left_val->u.double_value, right_val->u.double_value,
&result, left->line_number);
} else if (left_val->type == SIMCAR_INT_VALUE
&& right_val->type == SIMCAR_DOUBLE_VALUE) {
eval_binary_double(inter, operato,
(double)left_val->u.int_value,
right_val->u.double_value,
&result, left->line_number);
} else if (left_val->type == SIMCAR_DOUBLE_VALUE
&& right_val->type == SIMCAR_INT_VALUE) {
eval_binary_double(inter, operato,
left_val->u.double_value,
(double)right_val->u.int_value,
&result, left->line_number);
} else if (left_val->type == SIMCAR_BOOLEAN_VALUE
&& right_val->type == SIMCAR_BOOLEAN_VALUE) {
result.type = SIMCAR_BOOLEAN_VALUE;
result.u.boolean_value
= eval_binary_boolean(inter, operato,
left_val->u.boolean_value,
right_val->u.boolean_value,
left->line_number);
} else if (left_val->type == SIMCAR_STRING_VALUE
&& operato == ADD_EXPRESSION) {
chain_string(inter, left_val, right_val, &result);
} else if (left_val->type == SIMCAR_STRING_VALUE
&& right_val->type == SIMCAR_STRING_VALUE) {
result.type = SIMCAR_BOOLEAN_VALUE;
result.u.boolean_value
= eval_compare_string(operato, left_val, right_val,
left->line_number);
} else if (left_val->type == SIMCAR_NULL_VALUE
|| right_val->type == SIMCAR_NULL_VALUE) {
result.type = SIMCAR_BOOLEAN_VALUE;
result.u.boolean_value
= eval_binary_null(inter, operato, left_val, right_val,
left->line_number);
} else {
char *op_str = crb_get_operator_string(operato);
crb_runtime_error(left->line_number, BAD_OPERAND_TYPE_ERR,
STRING_MESSAGE_ARGUMENT, "operator", op_str,
MESSAGE_ARGUMENT_END);
}
pop_value(inter);
pop_value(inter);
push_value(inter, &result);
}
