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

diff --git a/src/compiler/gtn.lisp b/src/compiler/gtn.lisp
index b665ddf..af808d2 100644
--- a/src/compiler/gtn.lisp
+++ b/src/compiler/gtn.lisp
@@ -40,8 +40,15 @@
   (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))))
              (res (make-normal-tn type))
              (node (lambda-bind fun))
@@ -54,18 +61,9 @@
           ;; 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) (svref *backend-sc-numbers*
-                                   sb!vm:control-stack-sc-number))
-          ;; KLUDGE: In the case of a tail-local-call, the entire
-          ;; stack frame is overwritten by the physenv of the called
-          ;; function.  Unfortunately, the tail-call appears to end
-          ;; the dynamic contour of the physenv, meaning that the
-          ;; stack slot occupied by the LAMBDA-VAR may be reassigned.
-          ;; Ideally, we might make the TN physenv-live across the
-          ;; physenvs of the tail-set of the lambda, but as a stopgap
-          ;; we can make it component-live instead.
-          (component-live-tn res)
-          #+(or)
+          (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