diff options
| -rw-r--r-- | share/txr/stdlib/asm.tl | 24 | ||||
| -rw-r--r-- | vm.c | 35 | ||||
| -rw-r--r-- | vmop.h | 2 |
3 files changed, 57 insertions, 4 deletions
diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl index 1cbaba87..be442950 100644 --- a/share/txr/stdlib/asm.tl +++ b/share/txr/stdlib/asm.tl @@ -755,6 +755,30 @@ (unless (minusp fix) (add (operand-to-sym y)))))))))))) +(defopcode op-getlx getlx auto + (:method asm (me asm syntax) + me.(chk-arg-count 2 syntax) + (tree-bind (dst idx) asm.(parse-args me syntax '(d n)) + (cond + ((small-op-p dst) + asm.(put-insn me.code (enc-small-op dst) idx)) + (t asm.(put-insn me.code (enc-small-op 1) idx) + asm.(asm-one ^(mov ,(operand-to-exp dst) t1)))))) + (:method dis (me asm dst idx) + ^(,me.symbol ,(operand-to-sym dst) ,idx))) + +(defopcode op-setlx setlx auto + (:method asm (me asm syntax) + me.(chk-arg-count 2 syntax) + (tree-bind (src idx) asm.(parse-args me syntax '(r n)) + (cond + ((small-op-p src) + asm.(put-insn me.code (enc-small-op src) idx)) + (t asm.(asm-one ^(mov t1 ,(operand-to-exp src))) + asm.(put-insn me.code (enc-small-op 1) idx))))) + (:method dis (me asm src idx) + ^(,me.symbol ,(operand-to-sym src) ,idx))) + (defun disassemble-cdf (code data funv *stdout*) (let ((asm (new assembler buf code))) (put-line "data:") @@ -491,7 +491,8 @@ NOINLINE static void vm_apply(struct vm *vm, vm_word_t insn) vm_set(vm->dspl, dest, result); } -static loc vm_stab(struct vm *vm, unsigned fun) +static loc vm_stab(struct vm *vm, unsigned fun, + val (*lookup_fn)(val env, val sym), val kind_str) { struct vm_desc *vd = vm->vd; struct vm_stent *fe = &vd->stab[fun]; @@ -502,7 +503,7 @@ static loc vm_stab(struct vm *vm, unsigned fun) if (nilp(fe->bind = lookup_fn(nil, vecref(vd->symvec, num_fast(fun))))) eval_error(vd->bytecode, - lit("function ~s is not defined"), + lit("~a ~s is not defined"), kind_str, vecref(vd->symvec, num(fun)), nao); gc_mutated(vd->self); return (fe->bindloc = cdr_l(fe->bind)); @@ -533,7 +534,8 @@ NOINLINE static void vm_gcall(struct vm *vm, vm_word_t insn) } } - result = generic_funcall(deref(vm_stab(vm, fun)), args); + result = generic_funcall(deref(vm_stab(vm, fun, lookup_fun, + lit("function"))), args); vm_set(vm->dspl, dest, result); } @@ -562,7 +564,8 @@ NOINLINE static void vm_gapply(struct vm *vm, vm_word_t insn) } } - result = applyv(deref(vm_stab(vm, fun)), args); + result = applyv(deref(vm_stab(vm, fun, lookup_fun, + lit("function"))), args); vm_set(vm->dspl, dest, result); } @@ -855,6 +858,24 @@ NOINLINE static void vm_bindv(struct vm *vm, vm_word_t insn) env_vbind(dyn_env, sym, vm_get(vm->dspl, src)); } +NOINLINE static void vm_gettab(struct vm *vm, vm_word_t insn, + val (*lookup_fn)(val env, val sym), + val kind_str) +{ + unsigned idx = vm_insn_operand(insn); + unsigned dst = vm_insn_extra(insn); + vm_sm_set(vm->dspl, dst, deref(vm_stab(vm, idx, lookup_fn, kind_str))); +} + +NOINLINE static void vm_settab(struct vm *vm, vm_word_t insn, + val (*lookup_fn)(val env, val sym), + val kind_str) +{ + unsigned idx = vm_insn_operand(insn); + unsigned src = vm_insn_extra(insn); + set(vm_stab(vm, idx, lookup_fn, kind_str), vm_sm_get(vm->dspl, src)); +} + NOINLINE static void vm_close(struct vm *vm, vm_word_t insn) { unsigned dst = vm_insn_bigop(insn); @@ -997,6 +1018,12 @@ NOINLINE static val vm_execute(struct vm *vm) case CLOSE: vm_close(vm, insn); break; + case GETLX: + vm_gettab(vm, insn, lookup_var, lit("variable")); + break; + case SETLX: + vm_settab(vm, insn, lookup_var, lit("variable")); + break; default: uw_throwf(error_s, lit("invalid opcode ~s"), num_fast(opcode), nao); } @@ -66,4 +66,6 @@ typedef enum vm_op { SETL1 = 37, BINDV = 38, CLOSE = 39, + GETLX = 40, + SETLX = 41, } vm_op_t; |