1.0.37.64: Fixtransforms for float TRUNCATE

* Detect ignored secondary values correctly * Handle being unused (no result LVAR) without dying at compile-time
akovalenko · Apr 26, 2010 · d9d7c98 · d9d7c98
1 parent f362077
commit d9d7c98
Show file tree

Hide file tree

Showing 3 changed files with 9 additions and 4 deletions.
diff --git a/NEWS b/NEWS
@@ -67,6 +67,8 @@ changes relative to sbcl-1.0.37:
     denormals.
   * bug fix: We were too eager in eliding range reduction tests on x87.
     The maximal magnitude is 2^63, not 2^64.
+  * bug fix: Transforms for TRUNCATE don't die when the result is completely
+    ignored anymore.
 
 changes in sbcl-1.0.37 relative to sbcl-1.0.36:
   * enhancement: Backtrace from THROW to uncaught tag on x86oids now shows

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
@@ -1522,16 +1522,19 @@
                                         (,type
                                          &optional (or ,type ,@other-float-arg-types integer))
                                         * :result result)
-                  (let ((result-type (lvar-derived-type result)))
+                  (let* ((result-type (and result
+                                           (lvar-derived-type result)))
+                         (compute-all (and (values-type-p result-type)
+                                           (not (type-single-value-p result-type)))))
                     (if (or (not y)
                             (and (constant-lvar-p y) (= 1 (lvar-value y))))
-                        (if (values-type-p result-type)
+                        (if compute-all
                             `(let ((res (,',unary x)))
                                (values res (- x (,',coerce res))))
                             `(let ((res (,',unary x)))
                                ;; Dummy secondary value!
                                (values res x)))
-                        (if (values-type-p result-type)
+                        (if compute-all
                             `(let* ((f (,',coerce y))
                                     (res (,',unary (/ x f))))
                                (values res (- x (* f (,',coerce res)))))

diff --git a/version.lisp-expr b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.37.63"
+"1.0.37.64"