X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fpack.lisp;h=87464f7bc763ce31ab47651202278f8368d003bf;hb=f7faed97898dd0e94a18b0d1fca03aaa0fe24ab0;hp=339903235a18ab4682209b68c9bf084ff786fc76;hpb=7f6e75c553b4465ced41c3640292834d803761eb;p=sbcl.git

diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index 3399032..87464f7 100644
--- a/src/compiler/pack.lisp
+++ b/src/compiler/pack.lisp
@@ -826,11 +826,22 @@
     (let* ((sc (tn-sc tn))
            (sb (sc-sb sc)))
       (when (eq (sb-kind sb) :finite)
-        (do ((offset (tn-offset tn) (1+ offset))
-             (end (+ (tn-offset tn) (sc-element-size sc))))
-            ((= offset end))
-          (declare (type index offset end))
-          (setf (svref (finite-sb-live-tns sb) offset) tn)))))
+        ;; KLUDGE: we can have "live" TNs that are neither read
+        ;; to nor written from, due to more aggressive (type-
+        ;; directed) constant propagation.  Such TNs will never
+        ;; be assigned an offset nor be in conflict with anything.
+        ;;
+        ;; Ideally, it seems to me we could make sure these TNs
+        ;; are never allocated in the first place in
+        ;; ASSIGN-LAMBDA-VAR-TNS.
+        (if (tn-offset tn)
+            (do ((offset (tn-offset tn) (1+ offset))
+                 (end (+ (tn-offset tn) (sc-element-size sc))))
+                ((= offset end))
+              (declare (type index offset end))
+              (setf (svref (finite-sb-live-tns sb) offset) tn))
+            (assert (and (null (tn-reads tn))
+                         (null (tn-writes tn))))))))
 
   (setq *live-block* block)
   (setq *live-vop* (ir2-block-last-vop block))