Let register allocation handle unused TNs due to constant folding

 Type-directed constant folding can leave lambda-vars that are neither dead
 nor read from or written to.  Ideally, it seems like we should make sure to
 transform those into REF to CONSTANTs, but the optimisation doesn't seem
 guaranteed to fire.  It looks like the TN could simply not be allocated
 in ASSIGN-LAMBDA-VAR-TNS, but I'm not sure how to test for that situation
 ahead of time yet.

 Kludges over lp#729765.

diff --git a/NEWS b/NEWS
index 77866cb..e48394e 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -41,6 +41,8 @@ changes relative to sbcl-1.0.49:
     (lp#308961)
   * bug fix: style warning during lambda-list introspection of generic
     functions with both optional and key argments.
+  * bug fix: regalloc doesn't barf on unused TNs due to type-directed constant
+    folding. (lp#729765)
 
 changes in sbcl-1.0.49 relative to sbcl-1.0.48:
   * minor incompatible change: WITH-LOCKED-HASH-TABLE no longer disables

diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index 3399032..87464f7 100644 (file)
--- 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))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 633efef..b3c9c0e 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3935,3 +3935,10 @@
 (with-test (:name (:bug-486812 double-float))
   (compile nil `(lambda ()
                   (sb-kernel:make-double-float -1 0))))
+
+(with-test (:name :bug-729765)
+  (compile nil `(lambda (a b)
+                  (declare ((integer 1 1) a)
+                           ((integer 0 1) b)
+                           (optimize debug))
+                  (lambda () (< b a)))))