1.0.19.7: refactor stack allocation decisions

[sbcl.git] / src / compiler / ir2tran.lisp

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 28a74da..ca486d1 100644 (file)
--- 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
   (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)))
 \f
 ;;;; leaf reference
          res)))
 \f
 ;;;; leaf reference

@@ -1430,17 +1429,23 @@
              (progn
                (labels ((,unbind (vars)
                           (declare (optimize (speed 2) (debug 0)))
              (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))
                         (,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)
                  (,bind ,vars ,vals))
                nil
                ,@body)