vm/asm: new instructions getlx and setlx.

These instructions can be used for accessing cached global
variable bindings through the symtab of the vm descriptor.
The compiler will use these for optimizing access to global
lexical variables.

* share/txr/stdlib/asm.tl (op-getlx, op-setlx): New opcode
classes.

* vm.c (vm_stab): Take the lookup function as an argument,
so this can be used for variable bindings.
(vm_gcall, vm_gapply): Pass lookup_fun function to vm_stab,
as well as the appropriate string for the unbound error.
(vm_gettab, vm_settab): New static functions.
(vm_execute): Implement GETLX and SETLX using vm_gettab and
vm_settab.

* vmop.h: Regenerated.

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:")
diff --git a/vm.c b/vm.c
index c0beeb53..c0a0d505 100644
--- a/vm.c
+++ b/vm.c
@@ -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);
     }
diff --git a/vmop.h b/vmop.h
index 48bfa903..cb2f41af 100644
--- a/vmop.h
+++ b/vmop.h
@@ -66,4 +66,6 @@ typedef enum vm_op {
   SETL1 = 37,
   BINDV = 38,
   CLOSE = 39,
+  GETLX = 40,
+  SETLX = 41,
 } vm_op_t;