From fa4fda0e8af76ca3cdf435c0aa186210a4e18d03 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 19 Mar 2018 21:57:53 -0700 Subject: 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. --- share/txr/stdlib/compiler.tl | 6 +++--- vm.c | 2 ++ 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++) { -- cgit v1.2.3