From 6596b18b95780986ff4eb511ab384da138adbb58 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Tue, 21 Jun 2011 21:12:36 -0400 Subject: [PATCH] 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. --- NEWS | 2 ++ src/compiler/pack.lisp | 21 ++++++++++++++++----- tests/compiler.pure.lisp | 7 +++++++ 3 files changed, 25 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 77866cb..e48394e 100644 --- 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 --- 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 --- 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))))) -- 1.7.10.4