#include "interpreter.h" #include "../../runtime/gc.h" #include "../../runtime/runtime.h" #include "runtime_externs.h" #include "stack.h" #include "types.h" #include "utils.h" struct State s; static inline int ip_read_int(char **ip) { *ip += sizeof(int); return *(int *)((*ip) - sizeof(int)); } static inline char ip_read_byte(char **ip) { return *(*ip)++; } static inline char *ip_read_string(char **ip, bytefile *bf) { return get_string(bf, ip_read_int(ip)); } const size_t BUFFER_SIZE = 1000; void run(bytefile *bf, int argc, char **argv) { size_t stack[STACK_SIZE]; void *buffer[BUFFER_SIZE]; construct_state(bf, &s, (void**)stack); #ifdef DEBUG_VERSION printf("--- interpreter run ---\n"); #endif const size_t OPS_SIZE = 13; const char *ops[] = { "+", "-", "*", "/", "%", "<", "<=", ">", ">=", "==", "!=", "&&", "!!"}; aint (*ops_func[])(void *, void *) = { &Ls__Infix_43, // + &Ls__Infix_45, // - &Ls__Infix_42, // * &Ls__Infix_47, // / &Ls__Infix_37, // % &Ls__Infix_60, // < &Ls__Infix_6061, // <= &Ls__Infix_62, // > &Ls__Infix_6261, // >= &Ls__Infix_6161, // == &Ls__Infix_3361, // != &Ls__Infix_3838, // && &Ls__Infix_3333, // !! }; const size_t PATS_SIZE = 7; const char *pats[] = {"=str", "#string", "#array", "#sexp", "#ref", "#val", "#fun"}; // argc, argv { s_push_i(BOX(argc)); void **argv_strs = calloc(argc, sizeof(void *)); for (size_t i = 0; i < argc; ++i) { argv_strs[i] = Bstring((aint *)&argv[i]); } s_push(Barray((aint *)&argv_strs, argc)); free(argv_strs); } #ifdef DEBUG_VERSION printf("- loop start\n"); #endif do { // char *before_op_ip = s.ip; // save to set s.prev_ip bool call_happened = false; if (s.ip >= bf->code_ptr + bf->code_size) { s_failure(&s, "instruction pointer is out of range (>= size)"); } if (s.ip < bf->code_ptr) { s_failure(&s, "instruction pointer is out of range (< 0)"); } s.instr_ip = s.ip; char x = ip_read_byte(&s.ip), h = (x & 0xF0) >> 4, l = x & 0x0F; #ifdef DEBUG_VERSION printf("0x%.8x\n", s.ip - bf->code_ptr - 1); #endif switch (h) { case 15: goto stop; /* BINOP */ case 0: // BINOP ops[l-1] if (l > OPS_SIZE) { s_failure(&s, "undefined binop type index"); } if (l < 1) { s_failure(&s, "negative binop type index"); } void *left = s_pop(); void *right = s_pop(); s_push((void *)ops_func[l - 1](right, left)); break; case 1: switch (l) { case 0: // CONST %d s_push_i(BOX(ip_read_int(&s.ip))); break; case 1: { // STRING %s void *str = ip_read_string(&s.ip, bf); s_push(Bstring((aint *)&str)); break; } case 2: { // SEXP %s %d // create sexpr with tag=%s and %d elements from // stack // params read from stack const char *name = ip_read_string(&s.ip, bf); aint args_count = ip_read_int(&s.ip); #ifdef DEBUG_VERSION printf("tag hash is %i, n is %i\n", UNBOX(LtagHash((char *)name)), args_count); #endif if (args_count < 0) { s_failure(&s, "args count should be >= 0"); } void **opr_buffer = args_count >= BUFFER_SIZE ? calloc(args_count + 1, sizeof(void *)) : buffer; for (size_t i = 1; i <= args_count; ++i) { opr_buffer[args_count - i] = s_pop(); } opr_buffer[args_count] = (void *)LtagHash((char *)name); void *sexp = Bsexp((aint *)opr_buffer, BOX(args_count + 1)); push_extra_root(sexp); s_push(sexp); pop_extra_root(sexp); if (args_count >= BUFFER_SIZE) { free(opr_buffer); } break; } case 3: { // STI - write by ref (?) // NOTE: example not found, no checks done void *elem = s_pop(); void **addr = (void **)s_pop(); *addr = elem; s_push(elem); break; } case 4: { // STA - write to array elem void *elem = s_pop(); aint index = s_pop_i(); void *data = s_pop(); s_push(Bsta(data, index, elem)); break; } case 5: { // JMP 0x%.8x int jmp_p = ip_read_int(&s.ip); if (jmp_p < 0) { s_failure(&s, "negative file offset jumps are not allowed"); } s.ip = bf->code_ptr + jmp_p; break; } case 6: // END if (!s_is_empty() && s.fp->prev_fp != 0) { s.fp->ret = *s_peek(); s_pop(); } s_exit_f(); break; case 7: // RET if (!s_is_empty() && s.fp->prev_fp != 0) { s.fp->ret = *s_peek(); s_pop(); } s_exit_f(); break; case 8: // DROP s_pop(); break; case 9: // DUP { s_push(*s_peek()); break; } case 10: // SWAP { void* x = s_pop(); void* y = s_pop(); s_push(y); s_push(x); // if (s.sp + 1 >= s.stack + STACK_SIZE || // (s.fp != NULL && s.sp + 1 >= f_locals(s.fp))) { // s_failure(&s, "can't SWAP: < 2 values on stack"); // } // void *v = *s.sp; // push_extra_root(v); // *s.sp = *(s.sp + 1); // *(s.sp + 1) = v; // pop_extra_root(v); } break; case 11: // ELEM { aint index = s_pop_i(); void *data = s_pop(); s_push(Belem(data, index)); } break; default: s_failure(&s, "invalid opcode"); // %d-%d\n", h, l); } break; case 2: { // LD %d void **var_ptr = var_by_category(to_var_category(l), ip_read_int(&s.ip)); s_push(*var_ptr); break; } case 3: { // LDA %d void **var_ptr = var_by_category(to_var_category(l), ip_read_int(&s.ip)); s_push(*var_ptr); break; } case 4: { // ST %d void **var_ptr = var_by_category(to_var_category(l), ip_read_int(&s.ip)); *var_ptr = *s_peek(); break; } case 5: switch (l) { case 0: { // CJMPz 0x%.8x int jmp_p = ip_read_int(&s.ip); if (jmp_p < 0) { s_failure(&s, "negative file offset jumps are not allowed"); } if (UNBOX(s_pop_i()) == 0) { s.ip = bf->code_ptr + jmp_p; } break; } case 1: { // CJMPnz 0x%.8x int jmp_p = ip_read_int(&s.ip); if (jmp_p < 0) { s_failure(&s, "negative file offset jumps are not allowed"); } if (UNBOX(s_pop_i()) != 0) { s.ip = bf->code_ptr + jmp_p; } break; } case 2: { // BEGIN %d %d // function begin int args_sz = ip_read_int(&s.ip); int locals_sz = ip_read_int(&s.ip); if (s.fp != NULL && s.call_ip == NULL) { s_failure(&s, "begin should only be called after call"); } s_enter_f(s.call_ip /*ip from call*/, s.is_closure_call, args_sz, locals_sz); break; } case 3: { // CBEGIN %d %d // NOTE: example not found, no checks done int args_sz = ip_read_int(&s.ip); int locals_sz = ip_read_int(&s.ip); if (s.fp != NULL && s.call_ip == NULL) { s_failure(&s, "begin should only be called after call"); } s_enter_f(s.call_ip /*ip from call*/, s.is_closure_call, args_sz, locals_sz); break; } case 4: // CLOSURE 0x%.8x { aint call_offset = ip_read_int(&s.ip); aint args_count = ip_read_int(&s.ip); for (aint i = 0; i < args_count; i++) { aint arg_type = ip_read_byte(&s.ip); aint arg_id = ip_read_int(&s.ip); void **var_ptr = var_by_category(to_var_category(l), ip_read_int(&s.ip)); s_push(*var_ptr); } s_push(bf->code_ptr + call_offset); void *closure = Bclosure((aint *)s.sp, args_count); push_extra_root(closure); s_popn(args_count + 1); s_push(closure); pop_extra_root(closure); break; } case 5: { // CALLC %d // call clojure aint args_count = ip_read_int(&s.ip); // args count call_happened = true; s.is_closure_call = true; s.call_ip = s.ip; s.ip = Belem(*s_nth(args_count), BOX(0)); // use offset instead ?? break; } case 6: { // CALL 0x%.8x %d // call function int call_p = ip_read_int(&s.ip); ip_read_int(&s.ip); // args count call_happened = true; s.is_closure_call = false; s.call_ip = s.ip; if (call_p < 0) { s_failure(&s, "negative file offset jumps are not allowed"); } s.ip = bf->code_ptr + call_p; break; } case 7: { // TAG %s %d const char *name = ip_read_string(&s.ip, bf); aint args_count = ip_read_int(&s.ip); #ifdef DEBUG_VERSION printf("tag hash is %i, n is %i, peek is %i\n", UNBOX(LtagHash((char *)name)), args_count, s_peek(&s)); #endif s_push_i(Btag(s_pop(), LtagHash((char *)name), BOX(args_count))); break; } case 8: // ARRAY %d s_push_i(Barray_patt(s_pop(), BOX(ip_read_int(&s.ip)))); break; case 9: { // FAIL %d %d int line = ip_read_int(&s.ip); // ?? int col = ip_read_int(&s.ip); // ?? Bmatch_failure(s_pop(), argv[0], BOX(line), BOX(col)); break; } case 10: // LINE %d s.current_line = ip_read_int(&s.ip); // maybe some metainfo should be collected break; default: s_failure(&s, "invalid opcode"); // %d-%d\n", h, l); } break; case 6: // PATT pats[l] // {"=str", "#string", "#array", "#sexp", "#ref", "#val", "#fun"} switch (l) { case 0: // =str s_push_i(Bstring_patt(s_pop(), s_pop())); break; case 1: // #string s_push_i(Bstring_tag_patt(s_pop())); break; case 2: // #array s_push_i(Barray_tag_patt(s_pop())); break; case 3: // #sexp s_push_i(Bsexp_tag_patt(s_pop())); break; case 4: // #ref s_push_i(Bunboxed_patt(s_pop())); break; case 5: // #val s_push_i(Bboxed_patt(s_pop())); break; case 6: // #fun s_push_i(Bclosure_tag_patt(s_pop())); break; default: s_failure(&s, "invalid opcode"); // %d-%d\n", h, l); } break; case 7: { switch (l) { case 0: // CALL Lread s_push_i(Lread()); break; case 1: // CALL Lwrite Lwrite(*s_peek_i()); break; case 2: // CALL Llength s_push_i(Llength(s_pop())); break; case 3: { // CALL Lstring void *val = s_pop(); void *str = Lstring((aint *)&val); s_push(str); break; } case 4: { // CALL Barray %d size_t elem_count = ip_read_int(&s.ip); if (elem_count < 0) { s_failure(&s, "elements count should be >= 0"); } void **opr_buffer = elem_count > BUFFER_SIZE ? calloc(elem_count, sizeof(void *)) : buffer; for (size_t i = 0; i < elem_count; ++i) { opr_buffer[elem_count - i - 1] = s_pop(); } void *array = Barray((aint *)opr_buffer, BOX(elem_count)); // NOTE: not shure if elems should be added s_push(array); if (elem_count > BUFFER_SIZE) { free(opr_buffer); } break; } default: s_failure(&s, "invalid opcode"); // %d-%d\n", h, l); } } break; default: s_failure(&s, "invalid opcode"); // %d-%d\n", h, l); } if (!call_happened) { s.is_closure_call = false; s.call_ip = NULL; } if (s.fp == NULL) { break; } #ifdef DEBUG_VERSION print_stack(&s); #endif } while (1); stop:; #ifdef DEBUG_VERSION printf("--- run end ---\n"); #endif cleanup_state(&s); }