X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgtn.lisp;h=af808d28f2c605a7567c60a4b99c144b59d52616;hb=2056118835600a7c4e372c796568ddada5824cf6;hp=1a22dd005c955597f9e1f13582fa62987fb1542f;hpb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;p=sbcl.git

diff --git a/src/compiler/gtn.lisp b/src/compiler/gtn.lisp
index 1a22dd0..af808d2 100644
--- a/src/compiler/gtn.lisp
+++ b/src/compiler/gtn.lisp
@@ -40,16 +40,35 @@
   (declare (type clambda fun))
   (dolist (var (lambda-vars fun))
     (when (leaf-refs var)
-      (let* ((type (if (lambda-var-indirect var)
-                       *backend-t-primitive-type*
+      (let* (ptype-info
+             (type (if (lambda-var-indirect var)
+                       (if (lambda-var-explicit-value-cell var)
+                           *backend-t-primitive-type*
+                           (or (first
+                                (setf ptype-info
+                                      (primitive-type-indirect-cell-type
+                                       (primitive-type (leaf-type var)))))
+                               *backend-t-primitive-type*))
                        (primitive-type (leaf-type var))))
-             (temp (make-normal-tn type))
+             (res (make-normal-tn type))
              (node (lambda-bind fun))
-             (res (if (or (and let-p (policy node (< debug 3)))
-                          (policy node (zerop debug))
-                          (policy node (= speed 3)))
-                      temp
-                      (physenv-debug-live-tn temp (lambda-physenv fun)))))
+             (debug-variable-p (not (or (and let-p (policy node (< debug 3)))
+                                        (policy node (zerop debug))
+                                        (policy node (= speed 3))))))
+        (cond
+         ((and (lambda-var-indirect var)
+               (not (lambda-var-explicit-value-cell var)))
+          ;; Force closed-over indirect LAMBDA-VARs without explicit
+          ;; VALUE-CELLs to the stack, and make sure that they are
+          ;; live over the dynamic contour of the physenv.
+          (setf (tn-sc res) (if ptype-info
+                                (second ptype-info)
+                                (sc-or-lose 'sb!vm::control-stack)))
+          (physenv-live-tn res (lambda-physenv fun)))
+
+         (debug-variable-p
+          (physenv-debug-live-tn res (lambda-physenv fun))))
+
         (setf (tn-leaf res) var)
         (setf (leaf-info var) res))))
   (values))
@@ -108,11 +127,14 @@
 ;;; -- It appears to be more efficient to use the standard convention,
 ;;;    since there are no non-TR local calls that could benefit from
 ;;;    a non-standard convention.
+;;; -- We're compiling with RETURN-FROM-FRAME instrumentation, which
+;;;    only works (on x86 and x86-64) for the standard convention.
 (defun use-standard-returns (tails)
   (declare (type tail-set tails))
   (let ((funs (tail-set-funs tails)))
     (or (and (find-if #'xep-p funs)
              (find-if #'has-full-call-use funs))
+        (some (lambda (fun) (policy fun (>= insert-debug-catch 2))) funs)
         (block punt
           (dolist (fun funs t)
             (dolist (ref (leaf-refs fun))