vm_value vm_execute(vm_instruction *program, int program_length, vm_value *ctable, int ctable_length) {
++invocation;
vm_state state0;
vm_state *state = &state0;
reset(state);
state->const_table = ctable;
state->const_table_length = ctable_length;
bool is_running = true;
restart:
while(is_running && state->program_pointer < program_length) {
is_running = true;
vm_value instr = program[state->program_pointer];
vm_opcode opcode = get_opcode(instr);
++state->program_pointer;
switch (opcode) {
case OP_LOAD_i: {
int reg0 = get_arg_r0(instr);
int val = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = val;
}
break;
case OP_LOAD_ps: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_plain_symbol);
}
break;
case OP_LOAD_cs: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_compound_symbol);
}
break;
case OP_LOAD_os: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_opaque_symbol);
}
break;
case OP_LOAD_f: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_function);
}
break;
case OP_LOAD_str: {
int reg0 = get_arg_r0(instr);
int value = get_arg_i(instr);
check_reg(reg0);
get_reg(reg0) = make_tagged_val(value, vm_tag_string);
}
break;
case OP_ADD: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
if(get_tag(arg1) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(arg1));
}
else if(get_tag(arg2) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(arg2));
}
check_reg(reg0);
int result = ((arg1 - int_bias) + (arg2 - int_bias)) + int_bias;
if(result < min_biased_int || result > max_biased_int) {
fail("Int overflow");
}
get_reg(reg0) = result;
}
break;
case OP_SUB: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
if(get_tag(arg1) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(arg1));
}
if(get_tag(arg2) != vm_tag_number) {
fail("Expected a number, but got %s ", value_to_type_string(arg2));
}
check_reg(reg0);
int result = ((arg1 - int_bias) - (arg2 - int_bias)) + int_bias;
if(result < min_biased_int || result > max_biased_int) {
fail("Int overflow");
}
get_reg(reg0) = result;
}
break;
case OP_MUL: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
if(get_tag(arg1) != vm_tag_number) {
fail("Expected a number, but got %s ", value_to_type_string(arg1) );
}
if(get_tag(arg2) != vm_tag_number) {
fail("Expected a number, but got %s ", value_to_type_string(arg2) );
}
check_reg(reg0);
int result = ((arg1 - int_bias) * (arg2 - int_bias)) + int_bias;
if(result < min_biased_int || result > max_biased_int) {
panic_stop_vm_m("Int overflow");
}
get_reg(reg0) = result;
}
break;
case OP_DIV: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
if(arg2 == 0) {
fail("Division by 0");
}
if(get_tag(arg1) != vm_tag_number) {
fail("Expected a number, but got %s ", value_to_type_string(arg1) );
}
if(get_tag(arg2) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(arg2) );
}
int reg0 = get_arg_r0(instr);
check_reg(reg0);
int result = ((arg1 - int_bias) / (arg2 - int_bias)) + int_bias;
if(result < min_biased_int || result > max_biased_int) {
fail("Int overflow");
}
get_reg(reg0) = result;
}
break;
case OP_MOVE: {
int reg0 = get_arg_r0(instr);
int reg1 = get_arg_r1(instr);
check_reg(reg0);
check_reg(reg1);
get_reg(reg0) = get_reg(reg1);
}
break;
case OP_AP: {
if (state->stack_pointer + 1 == stack_size) {
fail("(call)!");
}
// this macro will create `return_pointer`
do_call((&next_frame), get_arg_r1(instr), instr);
if (call_failed) {
fail("call failed"); //TODO give a better error description
}
next_frame.return_address = return_pointer;
next_frame.result_register = get_arg_r0(instr);
++state->stack_pointer;
}
break;
case OP_TAIL_AP: {
do_call((¤t_frame), get_arg_r1(instr), instr);
if (call_failed) {
fail("call failed"); //TODO give a better error description
}
}
break;
case OP_GEN_AP: {
if (state->stack_pointer + 1 == stack_size) {
printf("Stack overflow (call cl)!");
panic_stop_vm();
}
int return_pointer = do_gen_ap(state, (&next_frame), instr, program);
if (return_pointer != -1) {
next_frame.return_address = return_pointer;
next_frame.result_register = get_arg_r0(instr);
++state->stack_pointer;
}
}
break;
// TODO It's not entirely clear yet what happens when this returns a new PAP
case OP_TAIL_GEN_AP: {
do_gen_ap(state, ¤t_frame, instr, program);
}
break;
op_ret:
case OP_RET: {
int return_val_reg = get_arg_r0(instr);
if (state->stack_pointer == 0) {
//We simply copy the result value to register 0, so that the runtime can find it
current_frame.reg[0] = current_frame.reg[return_val_reg];
is_running = false;
break;
}
--state->stack_pointer;
current_frame.reg[next_frame.result_register] = next_frame.reg[return_val_reg];
state->program_pointer = next_frame.return_address;
}
break;
case OP_JMP: {
int offset = get_arg_i(instr) - int_bias;
state->program_pointer += offset;
if(state->program_pointer < 0 || state->program_pointer > program_length) {
panic_stop_vm_m("Illegal address!");
}
}
break;
case OP_JMP_TRUE: {
check_reg(get_arg_r0(instr));
vm_value bool_value = get_reg(get_arg_r0(instr));
if( is_equal(state, bool_value, make_tagged_val(symbol_id_true, vm_tag_plain_symbol) )) {
int offset = get_arg_i(instr) - int_bias;
state->program_pointer += offset;
if(state->program_pointer < 0 || state->program_pointer > program_length) {
panic_stop_vm_m("Illegal address: %i", state->program_pointer);
}
}
// else: do nothing
}
break;
case OP_MATCH: {
check_reg(get_arg_r0(instr));
int subject = get_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
int patterns_addr = get_reg(get_arg_r1(instr));
int capture_reg = get_arg_r2(instr);
check_reg(capture_reg);
check_ctable_index(patterns_addr)
vm_value match_header = state->const_table[patterns_addr];
int number_of_patterns = from_match_value(match_header);
int i = 0;
for(i=0; i<number_of_patterns; ++i) {
int rel_pat_addr = patterns_addr + 1 + i;
check_ctable_index(rel_pat_addr)
vm_value pat = state->const_table[rel_pat_addr];
if(does_value_match(state, pat, subject, capture_reg)) {
break;
}
else {
continue;
}
}
if(i == number_of_patterns) {
throw("Pattern match failed!");
}
state->program_pointer += i;
}
break;
case OP_SET_ARG: {
int target_arg = get_arg_r0(instr);
int source_reg = get_arg_r1(instr);
int extra_amount = get_arg_r2(instr);
memcpy(&next_frame.reg[target_arg], ¤t_frame.reg[source_reg], (1 + extra_amount) * sizeof(vm_value));
}
break;
case OP_SET_CL_VAL: {
int cl_reg = get_arg_r0(instr);
check_reg(cl_reg);
vm_value closure = get_reg(cl_reg);
if( get_tag(closure) != vm_tag_pap ) {
fail("Expected a closure, but got %s", value_to_type_string(closure));
}
heap_address cl_address = get_val(closure);
check_reg(get_arg_r1(instr));
vm_value new_value = get_reg(get_arg_r1(instr));
int arg_index = get_arg_r2(instr);
vm_value *cl_pointer = heap_get_pointer(cl_address);
int header = *cl_pointer;
int num_env_args = pap_var_count(header);
if(arg_index >= num_env_args) {
panic_stop_vm_m("Illegal closure modification (index: %i, num env vars: %i)", arg_index, num_env_args);
}
cl_pointer[pap_header_size + arg_index] = new_value;
}
break;
case OP_PART_AP: {
int reg0 = get_arg_r0(instr);
int fun_reg = get_arg_r1(instr);
check_reg(fun_reg);
int func = get_reg(fun_reg);
if( get_tag(func) != vm_tag_function ) {
fail("Expected a function, but got %s", value_to_type_string(func));
}
int fun_address = get_val(func);
int num_args = get_arg_r2(instr);
vm_value fun_header = program[fun_address];
//TODO check that it's actually a function
int arity = get_arg_i(fun_header);
// TODO this was >= earlier, which apparently gave false positives. Find out why, and find out if > is the correct choice
if(num_args > arity) {
panic_stop_vm_m("Illegal partial application (num args: %i, arity: %i)", num_args, arity);
}
int pap_arity = arity - num_args;
build_pap(num_args, pap_arity, 0, num_args, fun_address);
check_reg(reg0);
get_reg(reg0) = pap_value;
}
break;
case OP_EQ: {
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value l = get_reg(get_arg_r1(instr));
vm_value r = get_reg(get_arg_r2(instr));
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
if( is_equal(state, l, r)) {
get_reg(result_reg) = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
}
else {
get_reg(result_reg) = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
}
}
break;
case OP_LT: {
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value l = get_reg(get_arg_r1(instr));
vm_value r = get_reg(get_arg_r2(instr));
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
if(get_tag(l) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(l));
}
else if(get_tag(r) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(r));
}
if( l < r) {
get_reg(result_reg) = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
}
else {
get_reg(result_reg) = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
}
}
break;
case OP_GT: {
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value l = get_reg(get_arg_r1(instr));
vm_value r = get_reg(get_arg_r2(instr));
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
if(get_tag(l) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(l));
}
else if(get_tag(r) != vm_tag_number) {
fail("Expected a number, but got %s", value_to_type_string(r));
}
if( l > r) {
get_reg(result_reg) = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
}
else {
get_reg(result_reg) = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
}
}
break;
case OP_COPY_SYM: {
check_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
vm_value const_symbol = get_reg(get_arg_r1(instr));
if ( get_tag(const_symbol) != vm_tag_compound_symbol ) {
panic_stop_vm_m("Expected a const symbol, but got %s", value_to_type_string(const_symbol));
}
int c_addr = get_val(const_symbol);
vm_value c_sym_header = state->const_table[c_addr];
int count = compound_symbol_count(c_sym_header);
size_t total_size = compound_symbol_header_size + count;
heap_address dyn_sym_address = heap_alloc(total_size);
vm_value *sym_pointer = heap_get_pointer(dyn_sym_address); \
memcpy(sym_pointer, &(state->const_table[c_addr]), total_size * sizeof(vm_value));
get_reg(get_arg_r0(instr)) = make_tagged_val(dyn_sym_address, vm_tag_dynamic_compound_symbol);
}
break;
case OP_SET_SYM_FIELD: {
check_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
vm_value heap_symbol = get_reg(get_arg_r0(instr));
if ( get_tag(heap_symbol) != vm_tag_dynamic_compound_symbol ) {
panic_stop_vm_m("Expected a dynamic symbol, but got %s", value_to_type_string(heap_symbol));
}
int h_addr = get_val(heap_symbol);
vm_value *p = heap_get_pointer(h_addr);
vm_value h_sym_header = *p;
int count = compound_symbol_count(h_sym_header);
int index = get_arg_r2(instr);
if(index < 0 || index >= count) {
panic_stop_vm_m("Illegal index while setting symbol field: %d", index);
}
p[compound_symbol_header_size + index] = get_reg(get_arg_r1(instr));
}
break;
case OP_STR_LEN: {
check_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
vm_value str = get_reg(get_arg_r1(instr));
int tag = get_tag(str);
if (tag != vm_tag_string && tag != vm_tag_dynamic_string ) {
fail("Expected a string, but got %s", value_to_type_string(str));
}
int str_addr = get_val(str);
vm_value *str_pointer;
if(tag == vm_tag_string) {
str_pointer = state->const_table + str_addr;
}
else {
str_pointer = heap_get_pointer(str_addr);
}
vm_value str_header = *str_pointer;
int count = string_length(str_header);
get_reg(get_arg_r0(instr)) = make_tagged_val(count + int_bias, vm_tag_number);
}
break;
case OP_NEW_STR: {
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
check_reg(get_arg_r1(instr));
vm_value length_value = get_reg(get_arg_r1(instr));
if(get_tag(length_value) != vm_tag_number) {
panic_stop_vm_m("Expected a number, but got %s", value_to_type_string(length_value));
}
int length = length_value - int_bias;
if(length < 0) {
panic_stop_vm_m("Negative length for new string, got: %d", length);
}
int adjusted_length = length + 1; // allow space for trailing '\0'
int num_chunks = adjusted_length / char_per_string_chunk;
if( (adjusted_length % char_per_string_chunk) != 0 ) {
num_chunks += char_per_string_chunk - (adjusted_length % char_per_string_chunk);
}
size_t total_size = string_header_size + num_chunks;
heap_address string_address = heap_alloc(total_size);
vm_value *str_pointer = heap_get_pointer(string_address);
memset(str_pointer, 0, total_size * sizeof(vm_value));
*str_pointer = string_header(length, num_chunks);
get_reg(result_reg) = make_tagged_val(string_address, vm_tag_dynamic_string);
}
break;
case OP_GET_CHAR: {
int result_reg = get_arg_r0(instr);
check_reg(result_reg);
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value str = get_reg(get_arg_r1(instr));
vm_value str_tag = get_tag(str);
if(str_tag != vm_tag_string && str_tag != vm_tag_dynamic_string) {
panic_stop_vm_m("Expected a string, but got %s", value_to_type_string(str));
}
int str_addr = get_val(str);
vm_value *str_pointer;
if(str_tag == vm_tag_string) {
str_pointer = state->const_table + str_addr;
}
else {
str_pointer = heap_get_pointer(str_addr);
}
vm_value str_header = *str_pointer;
int index = get_reg(get_arg_r2(instr)) - int_bias;
int str_length = string_length(str_header);
if(index < 0 || index > str_length) {
panic_stop_vm_m("Illegal string index: %d", index);
}
char *char_pointer = (char *) (str_pointer + string_header_size);
int character = char_pointer[index];
get_reg(result_reg) = make_tagged_val(character, vm_tag_number);
}
break;
case OP_PUT_CHAR: {
check_reg(get_arg_r0(instr));
check_reg(get_arg_r1(instr));
check_reg(get_arg_r2(instr));
vm_value str = get_reg(get_arg_r1(instr));
vm_value str_tag = get_tag(str);
if(str_tag != vm_tag_dynamic_string) {
panic_stop_vm_m("Expected a dynamic string, but got %s", value_to_type_string(str));
}
int character = get_reg(get_arg_r0(instr));
if(get_tag(character) != vm_tag_number) {
panic_stop_vm_m("Expected a number, but got %s", value_to_type_string(character));
}
int str_addr = get_val(str);
vm_value *str_pointer = heap_get_pointer(str_addr);
vm_value str_header = *str_pointer;
int index = get_reg(get_arg_r2(instr)) - int_bias;
int str_length = string_length(str_header);
if(index < 0 || index > str_length) {
panic_stop_vm_m("Illegal string index: %d", index);
}
char *char_pointer = (char *) (str_pointer + string_header_size);
char_pointer[index] = (char) character;
}
break;
case OP_OR: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
check_reg(reg0);
vm_value result = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
vm_value true_sym = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
if(arg1 == true_sym || arg2 == true_sym) {
result = true_sym;
}
get_reg(reg0) = result;
}
break;
case OP_AND: {
int reg1 = get_arg_r1(instr);
int reg2 = get_arg_r2(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
check_reg(reg2);
int arg2 = get_reg(reg2);
int reg0 = get_arg_r0(instr);
check_reg(reg0);
vm_value result = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
vm_value true_sym = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
if(arg1 == true_sym && arg2 == true_sym) {
result = true_sym;
}
get_reg(reg0) = result;
}
break;
case OP_NOT: {
int reg1 = get_arg_r1(instr);
check_reg(reg1);
int arg1 = get_reg(reg1);
int reg0 = get_arg_r0(instr);
check_reg(reg0);
vm_value result = make_tagged_val(symbol_id_false, vm_tag_plain_symbol);
vm_value true_sym = make_tagged_val(symbol_id_true, vm_tag_plain_symbol);
if(arg1 != true_sym) {
result = true_sym;
}
//else: result is already set to false
get_reg(reg0) = result;
}
break;
case OP_GET_FIELD: {
int result_reg = get_arg_r0(instr);
int obj_reg = get_arg_r1(instr);
int sym_reg = get_arg_r2(instr);
check_reg(result_reg);
check_reg(obj_reg);
check_reg(sym_reg);
vm_value obj_ref = get_reg(obj_reg);
vm_value requested_name = get_reg(sym_reg);
if(get_tag(requested_name) != vm_tag_plain_symbol) {
panic_stop_vm_m("Malformed lookup!");
}
vm_value obj_header = 0;
vm_value *obj_fields = 0;
if(get_tag(obj_ref) == vm_tag_opaque_symbol) {
int obj_addr = get_val(obj_ref);
vm_value *obj_pointer = state->const_table + obj_addr;
vm_value obj_owner = obj_pointer[1];
if(obj_owner != make_tagged_val(0, vm_tag_plain_symbol)) {
panic_stop_vm_m("Malformed module!");
}
obj_header = obj_pointer[0];
obj_fields = obj_pointer + 2;
}
// TODO this branch is untested, as records are apparently always dynamic in this case (?!)
else if(get_tag(obj_ref) == vm_tag_compound_symbol) {
int obj_addr = get_val(obj_ref);
vm_value *obj_pointer = state->const_table + obj_addr;
obj_header = obj_pointer[0];
if(compound_symbol_id(obj_header) != symbol_id_record) {
fail("Expected a module or record, got %s", value_to_type_string(obj_ref));
}
obj_fields = obj_pointer + 1;
}
else if(get_tag(obj_ref) == vm_tag_dynamic_compound_symbol) {
int obj_addr = get_val(obj_ref);
vm_value *obj_pointer = heap_get_pointer(obj_addr);
//vm_value *obj_pointer = state->const_table + obj_addr;
obj_header = obj_pointer[0];
obj_fields = obj_pointer + 1;
if(compound_symbol_id(obj_header) != symbol_id_record) {
fail("Expected a module or record, got %s", value_to_type_string(obj_ref));
}
}
else {
// exits subroutine here
fail("Expected a module or record, got %s", value_to_type_string(obj_ref));
}
int num_symbol_fields = compound_symbol_count(obj_header);
bool found = false;
for(int i=0; i < num_symbol_fields; i += 2) {
vm_value name = obj_fields[i];
if(name == requested_name) {
get_reg(result_reg) = obj_fields[i+1];
found = true;
break;
}
}
if(found == false) {
//TODO change this to built-in nil type
get_reg(result_reg) = make_tagged_val(symbol_id_nil, vm_tag_plain_symbol);
}
}
break;
case OP_CONVERT: {
int result_reg = get_arg_r0(instr);
int source_reg = get_arg_r1(instr);
int type_reg = get_arg_r2(instr);
check_reg(result_reg);
check_reg(source_reg);
check_reg(type_reg);
vm_value source = get_reg(source_reg);
vm_value target_type = get_reg(type_reg);
if(get_tag(target_type) != vm_tag_plain_symbol) {
fail("Expected a symbol, got %s", value_to_type_string(target_type));
}
vm_value target_type_id = get_val(target_type);
vm_value result;
switch(target_type_id) {
case symbol_id_number:
result = convert_to_number(state, source);
break;
case symbol_id_string:
result = convert_to_string(state, source);
break;
default:
result = make_str_error("Unable to convert value");
}
get_reg(result_reg) = result;
}
break;
default:
panic_stop_vm_m("UNKNOWN OPCODE: %04x", opcode);
}
}
vm_value result = state->stack[state->stack_pointer].reg[0];
vm_value io_result_value = 0;
vm_value next_action;
io_action_result action_result = check_io_action(state, result, program, &io_result_value, &next_action);
switch(action_result) {
case no_io_action:
// do nothing
break;
case intermediary_io_action: {
state->stack_pointer = 0;
current_frame.reg[0] = next_action;
next_frame.reg[0] = io_result_value; // argument for next_action
vm_instruction instr = op_gen_ap(0, 0, 1);
int return_pointer = do_gen_ap(state, ¤t_frame, instr, program);
if (return_pointer != -1) {
current_frame.return_address = return_pointer;
current_frame.result_register = 0;
}
else {
// TODO is this malformed?
panic_stop_vm_m("malformed bound lambda in io action");
}
is_running = true;
}
goto restart;
case final_io_action:
result = io_result_value;
break;
default:
panic_stop_vm_m("Unknown result of io action: %d", action_result);
}
return result;
}
STATIC void emit_inline_xtensa_op(emit_inline_asm_t *emit, qstr op, mp_uint_t n_args, mp_parse_node_t *pn_args) {
size_t op_len;
const char *op_str = (const char*)qstr_data(op, &op_len);
if (n_args == 0) {
if (op == MP_QSTR_ret_n) {
asm_xtensa_op_ret_n(&emit->as);
} else {
goto unknown_op;
}
} else if (n_args == 1) {
if (op == MP_QSTR_callx0) {
uint r0 = get_arg_reg(emit, op_str, pn_args[0]);
asm_xtensa_op_callx0(&emit->as, r0);
} else if (op == MP_QSTR_j) {
int label = get_arg_label(emit, op_str, pn_args[0]);
asm_xtensa_j_label(&emit->as, label);
} else if (op == MP_QSTR_jx) {
uint r0 = get_arg_reg(emit, op_str, pn_args[0]);
asm_xtensa_op_jx(&emit->as, r0);
} else {
goto unknown_op;
}
} else if (n_args == 2) {
uint r0 = get_arg_reg(emit, op_str, pn_args[0]);
if (op == MP_QSTR_beqz) {
int label = get_arg_label(emit, op_str, pn_args[1]);
asm_xtensa_bccz_reg_label(&emit->as, ASM_XTENSA_CCZ_EQ, r0, label);
} else if (op == MP_QSTR_bnez) {
int label = get_arg_label(emit, op_str, pn_args[1]);
asm_xtensa_bccz_reg_label(&emit->as, ASM_XTENSA_CCZ_NE, r0, label);
} else if (op == MP_QSTR_mov || op == MP_QSTR_mov_n) {
// we emit mov.n for both "mov" and "mov_n" opcodes
uint r1 = get_arg_reg(emit, op_str, pn_args[1]);
asm_xtensa_op_mov_n(&emit->as, r0, r1);
} else if (op == MP_QSTR_movi) {
// for convenience we emit l32r if the integer doesn't fit in movi
uint32_t imm = get_arg_i(emit, op_str, pn_args[1], 0, 0);
asm_xtensa_mov_reg_i32(&emit->as, r0, imm);
} else {
goto unknown_op;
}
} else if (n_args == 3) {
// search table for 3 arg instructions
for (uint i = 0; i < MP_ARRAY_SIZE(opcode_table_3arg); i++) {
const opcode_table_3arg_t *o = &opcode_table_3arg[i];
if (op == o->name) {
uint r0 = get_arg_reg(emit, op_str, pn_args[0]);
uint r1 = get_arg_reg(emit, op_str, pn_args[1]);
if (o->type == RRR) {
uint r2 = get_arg_reg(emit, op_str, pn_args[2]);
asm_xtensa_op24(&emit->as, ASM_XTENSA_ENCODE_RRR(0, o->a0, o->a1, r0, r1, r2));
} else if (o->type == RRI8_B) {
int label = get_arg_label(emit, op_str, pn_args[2]);
asm_xtensa_bcc_reg_reg_label(&emit->as, o->a0, r0, r1, label);
} else {
int shift, min, max;
if ((o->type & 0xf0) == 0) {
shift = 0;
min = -128;
max = 127;
} else {
shift = (o->type & 0xf0) >> 5;
min = 0;
max = 0xff << shift;
}
uint32_t imm = get_arg_i(emit, op_str, pn_args[2], min, max);
asm_xtensa_op24(&emit->as, ASM_XTENSA_ENCODE_RRI8(o->a0, o->a1, r1, r0, (imm >> shift) & 0xff));
}
return;
}
}
goto unknown_op;
} else {
/*
How to handle oversaturated calls:
When a call is oversaturated, we set up the first call as usual. All additional
arguments are stored on the heap, with a very simple format: First word is the
number of stored arguments, followed by the arguments we want to store away. The
heap address of that arg array is stored in a special field in the frame.
The call is instructed to return to the gen_ap call. The result will be stored in
the calls result register (which is the only safe place to store it).
When returning to the gen_ap instruction, the field for oversaturated calls is checked.
If it is set, the arguments are copied to the next_frame and the number of arguments
is set to the number of arguments we had stored. The frame field for oversaturated calls
is reset to 0.
After this the call proceeds as usual, possibly leading to another oversaturated call.
*/
int do_gen_ap(vm_state *state, stack_frame *frame, vm_value instr, vm_instruction *program) {
// TODO remove code duplication (in here, stack push, etc)
// TODO find a better term for "function or closure" than lambda
int lambda_reg = get_arg_r1(instr);
int num_args = get_arg_r2(instr);
// Check whether we are currently applying an oversaturated call
if(current_frame.spilled_arguments != 0) {
vm_value *addr = heap_get_pointer(current_frame.spilled_arguments);
num_args = compound_symbol_count(*addr);
memcpy(next_frame.reg, addr + 1, num_args * sizeof(vm_value));
lambda_reg = get_arg_r0(instr);
current_frame.spilled_arguments = 0;
}
check_reg(lambda_reg);
vm_value lambda = get_reg(lambda_reg);
vm_value tag = get_tag(lambda);
if(tag == vm_tag_pap ) {
heap_address cl_address = (heap_address)get_val(lambda);
vm_value *cl_pointer = heap_get_pointer(cl_address);
int header = *cl_pointer;
int arity = pap_arity(header);
int num_cl_vars = pap_var_count(header);
// Saturated closure application
if (num_args == arity) {
memmove(&(frame->reg[num_cl_vars]), next_frame.reg, num_args * sizeof(vm_value));
memcpy(&(frame->reg[0]), cl_pointer + pap_header_size, num_cl_vars * sizeof(vm_value));
// do the call
vm_value fun_address = *(cl_pointer + 1);
int return_pointer = state->program_pointer;
state->program_pointer = fun_address + fun_header_size;
return return_pointer;
}
// Undersaturated closure application
else if (num_args < arity) {
// create a new PAP by copying the old one and adding the new arguments
vm_value fun_address = *(cl_pointer + 1);
vm_value reg0 = get_arg_r0(instr);
int num_pap_args = num_cl_vars + num_args;
int pap_arity = arity - num_args;
int offset = num_cl_vars;
build_pap(num_pap_args, pap_arity, offset, num_args, fun_address)
memcpy(pap_pointer + pap_header_size, cl_pointer + pap_header_size, num_cl_vars * sizeof(vm_value));
check_reg(reg0);
get_reg(reg0) = pap_value;
return -1;
}
// Oversaturated closure application
else { // num_args > arity
prep_oversaturated_call(arity, num_args)
// set arguments
memmove(&(next_frame.reg[num_cl_vars]), &(next_frame.reg[0]), arity * sizeof(vm_value));
memcpy(&(next_frame.reg[0]), cl_pointer + pap_header_size, num_cl_vars * sizeof(vm_value));
// do the call
vm_value fun_address = *(cl_pointer + 1);
state->program_pointer = fun_address + fun_header_size;
++state->stack_pointer;
return -1;
}
}
else if (tag == vm_tag_function) {
int fun_address = get_val(lambda);
vm_instruction fun_header = program[fun_address];
//TODO check fun header "opcode"
int arity = get_arg_i(fun_header);
// saturated function application
if (num_args == arity) {
do_call(frame, lambda_reg, instr);
if(call_failed) {
fprintf(stderr, "Call failed (not a function)\n");
return -1; //TODO exit here?
}
return return_pointer;
}
// Unsersaturated function application
else if (num_args < arity) {
//vm_value fun_header = program[fun_address];
//TODO check that it's actually a function
vm_value reg0 = get_arg_r0(instr);
int pap_arity = arity - num_args;
build_pap(num_args, pap_arity, 0, num_args, fun_address)
check_reg(reg0);
get_reg(reg0) = pap_value;
return -1;
}
// Oversaturated function application
else {
prep_oversaturated_call(arity, num_args)
do_call((&next_frame), lambda_reg, instr);
++state->stack_pointer;
return -1;
}
}
else {
fprintf(stderr, "Expected a function, but got %s \n", value_to_type_string(lambda));
//exit(-1);
}
return -1;
}
STATIC void emit_inline_thumb_op(emit_inline_asm_t *emit, qstr op, int n_args, mp_parse_node_t *pn_args) {
// TODO perhaps make two tables:
// one_args =
// "b", LAB, asm_thumb_b_n,
// "bgt", LAB, asm_thumb_bgt_n,
// two_args =
// "movs", RLO, I8, asm_thumb_movs_reg_i8
// "movw", REG, REG, asm_thumb_movw_reg_i16
// three_args =
// "subs", RLO, RLO, I3, asm_thumb_subs_reg_reg_i3
// 1 arg
if (strcmp(qstr_str(op), "b") == 0) {
if (!check_n_arg(op, n_args, 1)) {
return;
}
int label_num = get_arg_label(emit, op, pn_args, 0);
// TODO check that this succeeded, ie branch was within range
asm_thumb_b_n(emit->as, label_num);
} else if (strcmp(qstr_str(op), "bgt") == 0) {
if (!check_n_arg(op, n_args, 1)) {
return;
}
int label_num = get_arg_label(emit, op, pn_args, 0);
// TODO check that this succeeded, ie branch was within range
asm_thumb_bcc_n(emit->as, THUMB_CC_GT, label_num);
// 2 args
} else if (strcmp(qstr_str(op), "movs") == 0) {
if (!check_n_arg(op, n_args, 2)) {
return;
}
uint rlo_dest = get_arg_rlo(op, pn_args, 0);
int i_src = get_arg_i(op, pn_args, 1, 0xff);
asm_thumb_movs_rlo_i8(emit->as, rlo_dest, i_src);
} else if (strcmp(qstr_str(op), "movw") == 0) {
if (!check_n_arg(op, n_args, 2)) {
return;
}
uint rlo_dest = get_arg_rlo(op, pn_args, 0); // TODO can be reg lo or hi
int i_src = get_arg_i(op, pn_args, 1, 0xffff);
asm_thumb_movw_reg_i16(emit->as, rlo_dest, i_src);
} else if (strcmp(qstr_str(op), "cmp") == 0) {
if (!check_n_arg(op, n_args, 2)) {
return;
}
uint rlo = get_arg_rlo(op, pn_args, 0);
int i8 = get_arg_i(op, pn_args, 1, 0xff);
asm_thumb_cmp_rlo_i8(emit->as, rlo, i8);
// 3 args
} else if (strcmp(qstr_str(op), "subs") == 0) {
if (!check_n_arg(op, n_args, 3)) {
return;
}
uint rlo_dest = get_arg_rlo(op, pn_args, 0);
uint rlo_src = get_arg_rlo(op, pn_args, 1);
int i3_src = get_arg_i(op, pn_args, 2, 0x7);
asm_thumb_subs_rlo_rlo_i3(emit->as, rlo_dest, rlo_src, i3_src);
// unknown op
} else {
printf("SyntaxError: unsupported ARM Thumb instruction '%s'\n", qstr_str(op));
return;
}
}
