From 35c8f215451961d7551187261cdf6cbf2c6ee7d3 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 15 May 2023 06:26:55 -0700 Subject: vm: bugfix: global lexicals looked up dynamically. The getlx and setlx VM instructions are using dynamic lookup for uncached bindings, due to using the same lookup_fun search function. They should use lookup_global_fun. That doesn't have an environment parameter though, so the type is not right. However, the VM never uses the environment parameter; it's always passing nil. We will get rid of the environment parameter in the lookup_fn callback and introduce a few wrappers. * eval.c, eval.h (lookup_global_fun, lookup_dynamic_var, lookup_dynamic_sym_lisp1): New functions. * vm.c (vm_stab_slowpath, vm_get_binding): lookup_fn argument loses environment parameter, and so we don't have to pass nil. (vm_gcall, vm_gapply): Use pass lookup_global_fun to to vm_stab. (vm_getsym, vm_getbind, vm_setsym, vm_gettab, vm_settab): lookup_fn argument loses environment parameter. (vm_execute): lookup functions replaced with the appropriate one-argument ones. GETLX and SETLX see a behavior change, due to using lookup_global_var which doesn't search the dynamic environment. --- eval.c | 15 +++++++++++++++ eval.h | 3 +++ vm.c | 47 ++++++++++++++++++++++++----------------------- 3 files changed, 42 insertions(+), 23 deletions(-) diff --git a/eval.c b/eval.c index 3c8d83f5..ab54586e 100644 --- a/eval.c +++ b/eval.c @@ -530,6 +530,11 @@ val lookup_global_var(val sym) if2(autoload_try_var(sym), gethash(top_vb, sym))); } +val lookup_global_fun(val sym) +{ + return lookup_fun(nil, sym); +} + val lookup_var(val env, val sym) { if (env) { @@ -593,6 +598,16 @@ loc lookup_var_l(val env, val sym) uw_throwf(error_s, lit("variable ~s unexpectedly unbound"), sym, nao); } +val lookup_dynamic_var(val sym) +{ + return lookup_var(nil, sym); +} + +val lookup_dynamic_sym_lisp1(val sym) +{ + return lookup_sym_lisp1(nil, sym); +} + static val lookup_mac(val menv, val sym); val lookup_fun(val env, val sym) diff --git a/eval.h b/eval.h index a927666f..26f30e5f 100644 --- a/eval.h +++ b/eval.h @@ -54,7 +54,10 @@ val deep_copy_env(val oenv); val env_fbind(val env, val sym, val fun); val env_vbind(val env, val sym, val obj); val lookup_var(val env, val sym); +val lookup_dynamic_var(val sym); +val lookup_dynamic_sym_lisp1(val sym); val lookup_global_var(val sym); +val lookup_global_fun(val sym); loc lookup_var_l(val env, val sym); val lookup_fun(val env, val sym); val lookup_sym_lisp1(val env, val sym); diff --git a/vm.c b/vm.c index 262ef934..080109d7 100644 --- a/vm.c +++ b/vm.c @@ -522,13 +522,13 @@ NOINLINE static void vm_apply(struct vm *vm, vm_word_t insn) NOINLINE static loc vm_stab_slowpath(struct vm *vm, unsigned fun, - val (*lookup_fn)(val env, val sym), + val (*lookup_fn)(val sym), val kind_str) { struct vm_desc *vd = vm->vd; struct vm_stent *fe = &vd->stab[fun]; - if (nilp(fe->bind = lookup_fn(nil, vecref(vd->symvec, num_fast(fun))))) + if (nilp(fe->bind = lookup_fn(vecref(vd->symvec, num_fast(fun))))) eval_error(vd->bytecode, lit("~a ~s is not defined"), kind_str, vecref(vd->symvec, num(fun)), nao); @@ -538,7 +538,7 @@ NOINLINE static loc vm_stab_slowpath(struct vm *vm, unsigned fun, } INLINE loc vm_stab(struct vm *vm, unsigned fun, - val (*lookup_fn)(val env, val sym), val kind_str) + val (*lookup_fn)(val sym), val kind_str) { struct vm_desc *vd = vm->vd; struct vm_stent *fe = &vd->stab[fun]; @@ -556,7 +556,8 @@ NOINLINE static void vm_gcall(struct vm *vm, vm_word_t insn) unsigned dest = vm_insn_operand(insn); vm_word_t argw = vm->code[vm->ip++]; unsigned funidx = vm_arg_operand_lo(argw); - val fun = deref(vm_stab(vm, funidx, lookup_fun, lit("function"))); + val fun = deref(vm_stab(vm, funidx, + lookup_global_fun, lit("function"))); val result; switch (nargs) { @@ -648,7 +649,7 @@ NOINLINE static void vm_gapply(struct vm *vm, vm_word_t insn) } } - result = applyv(deref(vm_stab(vm, fun, lookup_fun, + result = applyv(deref(vm_stab(vm, fun, lookup_global_fun, lit("function"))), args); vm_set(vm->dspl, dest, result); } @@ -860,11 +861,11 @@ NOINLINE static void vm_handle(struct vm *vm, vm_word_t insn) } static val vm_get_binding(struct vm *vm, vm_word_t insn, - val (*lookup_fn)(val env, val sym), + val (*lookup_fn)(val sym), val kind_str) { val sym = vm_sm_get(vm->dspl, vm_insn_extra(insn)); - val binding = lookup_fn(nil, sym); + val binding = lookup_fn(sym); if (nilp(binding)) eval_error(vm->vd->bytecode, lit("unbound ~a ~s"), kind_str, sym, nao); @@ -873,7 +874,7 @@ static val vm_get_binding(struct vm *vm, vm_word_t insn, } NOINLINE static void vm_getsym(struct vm *vm, vm_word_t insn, - val (*lookup_fn)(val env, val sym), + val (*lookup_fn)(val sym), val kind_str) { val binding = vm_get_binding(vm, insn, lookup_fn, kind_str); @@ -882,7 +883,7 @@ NOINLINE static void vm_getsym(struct vm *vm, vm_word_t insn, } NOINLINE static void vm_getbind(struct vm *vm, vm_word_t insn, - val (*lookup_fn)(val env, val sym), + val (*lookup_fn)(val sym), val kind_str) { val binding = vm_get_binding(vm, insn, lookup_fn, kind_str); @@ -891,7 +892,7 @@ NOINLINE static void vm_getbind(struct vm *vm, vm_word_t insn, } NOINLINE static void vm_setsym(struct vm *vm, vm_word_t insn, - val (*lookup_fn)(val env, val sym), + val (*lookup_fn)(val sym), val kind_str) { val binding = vm_get_binding(vm, insn, lookup_fn, kind_str); @@ -912,7 +913,7 @@ NOINLINE static void vm_bindv(struct vm *vm, vm_word_t insn) } NOINLINE static void vm_gettab(struct vm *vm, vm_word_t insn, - val (*lookup_fn)(val env, val sym), + val (*lookup_fn)(val sym), val kind_str) { unsigned idx = vm_insn_operand(insn); @@ -921,7 +922,7 @@ NOINLINE static void vm_gettab(struct vm *vm, vm_word_t insn, } NOINLINE static void vm_settab(struct vm *vm, vm_word_t insn, - val (*lookup_fn)(val env, val sym), + val (*lookup_fn)(val sym), val kind_str) { unsigned idx = vm_insn_operand(insn); @@ -1035,28 +1036,28 @@ NOINLINE static val vm_execute(struct vm *vm) vm_handle(vm, insn); break; case GETV: - vm_getsym(vm, insn, lookup_var, lit("variable")); + vm_getsym(vm, insn, lookup_dynamic_var, lit("variable")); break; case OLDGETF: - vm_getsym(vm, insn, lookup_fun, lit("function")); + vm_getsym(vm, insn, lookup_global_fun, lit("function")); break; case GETL1: - vm_getsym(vm, insn, lookup_sym_lisp1, lit("variable/function")); + vm_getsym(vm, insn, lookup_dynamic_sym_lisp1, lit("variable/function")); break; case GETVB: - vm_getbind(vm, insn, lookup_var, lit("variable")); + vm_getbind(vm, insn, lookup_dynamic_var, lit("variable")); break; case GETFB: - vm_getbind(vm, insn, lookup_fun, lit("function")); + vm_getbind(vm, insn, lookup_global_fun, lit("function")); break; case GETL1B: - vm_getbind(vm, insn, lookup_sym_lisp1, lit("variable/function")); + vm_getbind(vm, insn, lookup_dynamic_sym_lisp1, lit("variable/function")); break; case SETV: - vm_setsym(vm, insn, lookup_var, lit("variable")); + vm_setsym(vm, insn, lookup_dynamic_var, lit("variable")); break; case SETL1: - vm_setsym(vm, insn, lookup_sym_lisp1, lit("variable/function")); + vm_setsym(vm, insn, lookup_dynamic_sym_lisp1, lit("variable/function")); break; case BINDV: vm_bindv(vm, insn); @@ -1065,13 +1066,13 @@ NOINLINE static val vm_execute(struct vm *vm) vm_close(vm, insn); break; case GETLX: - vm_gettab(vm, insn, lookup_var, lit("variable")); + vm_gettab(vm, insn, lookup_global_var, lit("variable")); break; case SETLX: - vm_settab(vm, insn, lookup_var, lit("variable")); + vm_settab(vm, insn, lookup_global_var, lit("variable")); break; case GETF: - vm_gettab(vm, insn, lookup_fun, lit("function")); + vm_gettab(vm, insn, lookup_global_fun, lit("function")); break; default: uw_throwf(error_s, lit("invalid opcode ~s"), num_fast(opcode), nao); -- cgit v1.2.3