X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fir2tran.lisp;h=ca486d1a3c882e14ffe13f47f90a15244b18cae7;hb=6822034325136cde4e14773c83c3769b42721306;hp=28a74da42c6e02e5464ada44e50e27ba3cc63def;hpb=367316f5f21281204393853910848fea7fb9a6ab;p=sbcl.git

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 28a74da..ca486d1 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -58,9 +58,8 @@
   (event make-value-cell-event node)
   (let ((leaf (tn-leaf res)))
     (vop make-value-cell node block value
-         (and leaf (leaf-dynamic-extent leaf)
-              ;; FIXME: See bug 419
-              (policy node (> stack-allocate-value-cells 1)))
+         ;; FIXME: See bug 419
+         (and leaf (eq :truly (leaf-dynamic-extent leaf)))
          res)))
 
 ;;;; leaf reference
@@ -1430,17 +1429,23 @@
              (progn
                (labels ((,unbind (vars)
                           (declare (optimize (speed 2) (debug 0)))
-                          (dolist (var vars)
-                            (%primitive bind nil var)
-                            (makunbound var)))
+                          (let ((unbound-marker (%primitive make-other-immediate-type
+                                                            0 sb!vm:unbound-marker-widetag)))
+                            (dolist (var vars)
+                              ;; CLHS says "bound and then made to have no value" -- user
+                              ;; should not be able to tell the difference between that and this.
+                              (about-to-modify-symbol-value var "bind ~S")
+                              (%primitive bind unbound-marker var))))
                         (,bind (vars vals)
                           (declare (optimize (speed 2) (debug 0)))
                           (cond ((null vars))
                                 ((null vals) (,unbind vars))
-                                (t (%primitive bind
-                                               (car vals)
-                                               (car vars))
-                                   (,bind (cdr vars) (cdr vals))))))
+                                (t
+                                 (let ((val (car vals))
+                                       (var (car vars)))
+                                   (about-to-modify-symbol-value var "bind ~S" val)
+                                   (%primitive bind val var))
+                                 (,bind (cdr vars) (cdr vals))))))
                  (,bind ,vars ,vals))
                nil
                ,@body)