vm: release cached bindings that become unbound.

When a function binding is removed using fmakunbound, virtual
machine descriptions hang on to the previously cached binding
in the ftab. When the symbol is newly bound, virtual machine
descriptions keep pointing to the old function.

To solve this, we put the vm_desc structures into a global
list and provide a function that fmakunbound calls to scrub
all the VM descriptors of that binding.

* eval.c (makunbound, fmakunbound): Call new
vm_invalidate_binding function.

* vm.c (struct vm_desc_links): New structure.
(struct vm_desc): New member lnk, with links.
(vmd_list): New static variable: circular list of all VM
descriptors.
(vm_make_desc): Insert new VM descriptor into list.
(vm_desc_destroy): Remove VM descriptor from list.
(vm_invalidate_binding): New function.

* vm.h (vm_invalidate_binding): Declared.

3 files changed, 40 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index e621db2d..7957e20e 100644
--- a/eval.c
+++ b/eval.c
@@ -55,6 +55,7 @@
 #include "struct.h"
 #include "cadr.h"
 #include "filter.h"
+#include "vm.h"
 #include "eval.h"
 
 #define max(a, b) ((a) > (b) ? (a) : (b))
@@ -5329,6 +5330,8 @@ static val makunbound(val sym)
   remhash(top_smb, sym);
   remhash(special, sym);
 
+  vm_invalidate_binding(sym);
+
   return sym;
 }
 
@@ -5338,6 +5341,7 @@ static val fmakunbound(val sym)
   remhash(top_fb, sym);
   if (opt_compat && opt_compat <= 127)
     remhash(top_mb, sym);
+  vm_invalidate_binding(sym);
   return sym;
 }
 
diff --git a/vm.c b/vm.c
index a679cbb3..6460bac8 100644
--- a/vm.c
+++ b/vm.c
@@ -53,7 +53,12 @@ typedef u32_t vm_word_t;
 
 #define zalloca(size) memset(alloca(size), 0, size)
 
+struct vm_desc_links {
+  struct vm_desc *next, *prev;
+};
+
 struct vm_desc {
+  struct vm_desc_links lnk;
   val self;
   int nlvl;
   int nreg;
@@ -100,6 +105,10 @@ static_forward(struct cobj_ops vm_desc_ops);
 
 static_forward(struct cobj_ops vm_closure_ops);
 
+static struct vm_desc_links vmd_list = {
+  coerce(struct vm_desc *, &vmd_list), coerce(struct vm_desc *, &vmd_list)
+};
+
 static struct vm_desc *vm_desc_struct(val obj)
 {
   return coerce(struct vm_desc *, cobj_handle(obj, vm_desc_s));
@@ -125,6 +134,7 @@ val vm_make_desc(val nlevels, val nregs, val bytecode,
     cnum ftsz = c_num(length_vec(symvec));
     loc data_loc = if3(dvl != zero, vecref_l(datavec, zero), nulloc);
     struct vm_desc *vd = coerce(struct vm_desc *, chk_malloc(sizeof *vd));
+    struct vm_desc *vtail = vmd_list.prev, *vnull = vtail->lnk.next;
     struct vm_ftent *stab = if3(ftsz != 0,
                                 coerce(struct vm_ftent *,
                                        chk_calloc(ftsz, sizeof *stab)), 0);
@@ -152,6 +162,11 @@ val vm_make_desc(val nlevels, val nregs, val bytecode,
     vd->symvec = symvec;
     vd->self = desc;
 
+    vd->lnk.prev = vtail;
+    vd->lnk.next = vnull;
+    vnull->lnk.prev = vd;
+    vtail->lnk.next = vd;
+
     return desc;
   }
 }
@@ -189,6 +204,10 @@ static val vm_desc_symvec(val desc)
 static void vm_desc_destroy(val obj)
 {
   struct vm_desc *vd = coerce(struct vm_desc *, obj->co.handle);
+  struct vm_desc *vn = vd->lnk.next, *vp = vd->lnk.prev;
+  vp->lnk.next = vn;
+  vn->lnk.prev = vp;
+  vd->lnk.prev = vd->lnk.next = 0;
   free(vd->stab);
   free(vd);
 }
@@ -1081,6 +1100,22 @@ static val vm_closure_entry(val closure)
   return unum(vc->ip);
 }
 
+void vm_invalidate_binding(val sym)
+{
+  struct vm_desc *vd = vmd_list.next, *vnull = vd->lnk.prev;
+
+  for (; vd != vnull; vd = vd->lnk.next) {
+    cnum i;
+    for (i = 0; i < vd->ftsz; i++) {
+      if (vecref(vd->symvec, num_fast(i)) == sym) {
+        struct vm_ftent *sti = &vd->stab[i];
+        sti->fb = nil;
+        sti->fbloc = nulloc;
+      }
+    }
+  }
+}
+
 static_def(struct cobj_ops vm_desc_ops =
   cobj_ops_init(eq,
                 cobj_print_op,
diff --git a/vm.h b/vm.h
index da2fab08..30720d0d 100644
--- a/vm.h
+++ b/vm.h
@@ -31,4 +31,5 @@ val vm_make_desc(val nlevels, val nregs, val bytecode,
                  val datavec, val funvec);
 val vm_execute_toplevel(val desc);
 val vm_execute_closure(val fun, struct args *);
+void vm_invalidate_binding(val sym);
 void vm_init(void);