vm: bug: vm-desc created with incorrect display depth.

* share/txr/stdlib/compiler.tl (sys:env :postinit): The call
to register the environment with the compiler must be outside
of the unless form. Otherwise it never takes place, and so the
compiler doesn't find the maximum number of environment
levels, keeping the value at 2. The executing vm then accesses
out of bounds memory when setting up display frames.
(usr:compile-toplevel): Give the root environment the
compiler. Not strictly necessary since we are constent in
doing this elsewhere, so we are not relying on inheritance
of the compiler from parent environment to child.

* vm.c (vm_make_closure): assert added for the environment
levels of the closure not exceeding the display depth given
in the machine description. This was added during debugging
and going off; I'm keeping it.

2 files changed, 5 insertions, 3 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index d7f11229..24d64fc1 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -49,8 +49,8 @@
     (unless me.lev
       (set me.lev (if me.up (succ me.up.lev) 1)))
     (unless (or me.co (null me.up))
-      (set me.co me.up.co)
-      me.co.(new-env me)))
+      (set me.co me.up.co))
+    me.co.(new-env me))
 
   (:method lookup-var (me sym)
     (condlet
@@ -503,6 +503,6 @@
   (let ((co (new compiler))
         (as (new assembler)))
     (let* ((oreg co.(alloc-treg))
-           (frag co.(compile oreg (new env) (expand* exp))))
+           (frag co.(compile oreg (new env co co) (expand* exp))))
       as.(asm ^(,*frag.code (end ,frag.oreg)))
       (vm-make-desc co.nlev co.nreg as.buf co.(get-datavec) co.(get-funvec)))))
diff --git a/vm.c b/vm.c
index a837a268..17efa503 100644
--- a/vm.c
+++ b/vm.c
@@ -219,6 +219,8 @@ static val vm_make_closure(struct vm *vm, int frsz)
   vc->vd = vm->vd;
   vc->dspl = dspl;
 
+  assert (vc->nlvl <= vm->nlvl);
+
   closure = cobj(coerce(mem_t *, vc), vm_closure_s, &vm_closure_ops);
 
   for (i = 2; i < vc->nlvl; i++) {