From: Paul Khuong <pvk@pvk.ca>
Date: Sat, 20 Apr 2013 11:50:52 +0000 (+0200)
Subject: Substitute constants with modular equivalents more safely
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ccd2a1d4ab60a9539472df45fc4f9ec7b7fdc7b7;hp=0562f2b641c71b8461f9aac4a354ff4b341961fe;p=sbcl.git

Substitute constants with modular equivalents more safely

* Modular arithmetic sometimes lets us narrow constants down,
  especially with signed arithmetic. We now update the receiving
  LVAR's type conservatively when there are multiple uses; otherwise,
  conflicting type information results in spurious dead code
  elimination.

* Test case by Eric Marsden.

* Reported by Eric Marsden on sbcl-devel (2013-04-18).
---

diff --git a/NEWS b/NEWS
index c2cf5f2..7ba1204 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,8 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.1.6
+  * bug fix: modular arithmetic involving large constants and conditionals
+    should no longer result in spurious dead code elimination. Reported by 
+    Eric Marsden on sbcl-devel.
   * bug fix: our mach exception handler can seemingly called very early in
     the program execution process on OS X 10.8.0. Try and handle that case
     robustly, without potentially leaking mach ports too much.
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 5858da9..f6369e6 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -3060,7 +3060,10 @@
                                        (ldb (byte width 0) constant-value))))
                    (unless (= constant-value new-value)
                      (change-ref-leaf node (make-constant new-value))
-                     (setf (lvar-%derived-type (node-lvar node)) (make-values-type :required (list (ctype-of new-value))))
+                     (let ((lvar (node-lvar node)))
+                       (setf (lvar-%derived-type lvar)
+                             (and (lvar-has-single-use-p lvar)
+                                  (make-values-type :required (list (ctype-of new-value))))))
                      (setf (block-reoptimize (node-block node)) t)
                      (reoptimize-component (node-component node) :maybe)
                      (return-from cut-node t))))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 1a4fc7d..0e7c53c 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4383,3 +4383,17 @@
   (compile nil `(lambda (x)
                   (symbol-macrolet ((sv x))
                     (values (svref sv 0) (setf (svref sv 0) 99))))))
+
+;; The compiler used to update the receiving LVAR's type too
+;; aggressively when converting a large constant to a smaller
+;; (potentially signed) one, causing other branches to be
+;; inferred as dead.
+(with-test (:name :modular-cut-constant-to-width)
+  (let ((test (compile nil
+                       `(lambda (x)
+                          (logand 254
+                                  (case x
+                                    ((3) x)
+                                    ((2 2 0 -2 -1 2) 9223372036854775803)
+                                    (t 358458651)))))))
+    (assert (= (funcall test -10470605025) 26))))