From 30b4cd7fd4aa40616e089b834e34f1928c700ab1 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 14 May 2023 09:32:23 -0700
Subject: bug: symbol-value place always global.

We have a problem. If v is a dynamic variable, then
the form

  (let (v)
    (set (symbol-value 'v) 3))

is not behaving correctly; it's updating the top-level
value of v not the rebound one.

* eval.c (set_symbol_value): New static function.
(eval_init): Register sys:set-symbol-value intrinsic.
The top-vb variable, though no longer referenced by
the symbol-value place, because existing compiled
code depends on it.

* stdlib/place.tl (symbol-value): Rewrite the place
logic to use symbol-value to access the variable,
and set-symbol-value to update it, instead of referencing
sys:top-vb.
(sys:get-vb): This function has to stay, because it
provides run-time support for code compiled with the
buggy version of the place.

* tests/019/symbol-value.tl: New file.
---
 eval.c                    | 13 +++++++++++++
 stdlib/place.tl           |  8 ++++----
 tests/019/symbol-value.tl | 24 ++++++++++++++++++++++++
 3 files changed, 41 insertions(+), 4 deletions(-)
 create mode 100644 tests/019/symbol-value.tl

diff --git a/eval.c b/eval.c
index 0e247fda..3c8d83f5 100644
--- a/eval.c
+++ b/eval.c
@@ -5832,6 +5832,18 @@ static val symbol_value(val sym)
                  lookup_symac(nil, sym)));
 }
 
+static val set_symbol_value(val sym, val value)
+{
+  val vbind = lookup_var(nil, sym);
+
+  if (vbind)
+    rplacd(vbind, value);
+  else
+    sethash(top_vb, sym, cons(sym, value));
+
+  return value;
+}
+
 static val symbol_function(val sym)
 {
   uses_or2;
@@ -7579,6 +7591,7 @@ void eval_init(void)
   reg_varl(intern(lit("top-fb"), system_package), top_fb);
   reg_varl(intern(lit("top-mb"), system_package), top_mb);
   reg_fun(intern(lit("symbol-value"), user_package), func_n1(symbol_value));
+  reg_fun(intern(lit("set-symbol-value"), system_package), func_n2(set_symbol_value));
   reg_fun(intern(lit("symbol-function"), user_package), func_n1(symbol_function));
   reg_fun(intern(lit("symbol-macro"), user_package), func_n1(symbol_macro));
   reg_fun(intern(lit("boundp"), user_package), func_n1(boundp));
diff --git a/stdlib/place.tl b/stdlib/place.tl
index 13b9bb18..fdd4e544 100644
--- a/stdlib/place.tl
+++ b/stdlib/place.tl
@@ -862,10 +862,10 @@
 
 (defplace (symbol-value sym-expr) body
   (getter setter
-    (with-gensyms (binding-sym)
-      ^(let ((,binding-sym (sys:get-vb ,sym-expr)))
-          (macrolet ((,getter () ^(cdr ,',binding-sym))
-                     (,setter (val) ^(sys:rplacd ,',binding-sym ,val)))
+    (with-gensyms (sym)
+      ^(let ((,sym ,sym-expr))
+          (macrolet ((,getter () ^(symbol-value ,',sym))
+                     (,setter (val) ^(sys:set-symbol-value ,',sym ,val)))
             ,body))))
   nil
   (deleter
diff --git a/tests/019/symbol-value.tl b/tests/019/symbol-value.tl
new file mode 100644
index 00000000..ca724f5a
--- /dev/null
+++ b/tests/019/symbol-value.tl
@@ -0,0 +1,24 @@
+(load "../common")
+
+(defparm v 42)
+
+(mtest
+  v 42
+  (symbol-value 'v) 42
+  (set (symbol-value 'v) 73) 73
+  (symbol-value 'v) 73
+  v 73)
+
+(mtest
+  (let ((v 2)) v) 2
+  (let ((v 2)) (symbol-value 'v)) 2
+  (progn (let ((v 2)) (set (symbol-value 'v) 1)) v) 73
+  (let ((v 2)) (set (symbol-value 'v) 1) v) 1
+  v 73)
+
+(test
+  (progn
+    (let ((v 2))
+      (set (symbol-value 'x) 73))
+    x)
+  73)
-- 
cgit v1.2.3