1.0.34.11: properly inline %UNARY-TRUNCATE/{SINGLE,DOUBLE}-FLOAT

Add DERIVE-TYPE optimizers for them so the compiler can see that VOPs
are applicable.  Add a testcase that should be valid everywhere.

diff --git a/NEWS b/NEWS
index 7dfb70e..01a7863 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@
 changes relative to sbcl-1.0.34:
   * optimization: SB-ROTATE-BYTE:ROTATE-BYTE now generates more efficient
     code for 32-bit and 64-bit rotations on x86-64.
+  * bug fix: TRUNCATE with a single single-float or double-float argument is
+    properly inlined when possible.  (launchpad bug lp#489388)
   * bug fix: Passing a rotation count of zero to SB-ROTATE-BYTE:ROTATE-BYTE
     no longer causes a compiler error on x86 and ppc.
   * bug fix: GET-MACRO-CHARACTER bogusly computed its second return value

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 7421fd7..f084086 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -1789,6 +1789,16 @@
                        #'%unary-truncate-derive-type-aux
                        #'%unary-truncate))
 
+(defoptimizer (%unary-truncate/single-float derive-type) ((number))
+  (one-arg-derive-type number
+                       #'%unary-truncate-derive-type-aux
+                       #'%unary-truncate))
+
+(defoptimizer (%unary-truncate/double-float derive-type) ((number))
+  (one-arg-derive-type number
+                       #'%unary-truncate-derive-type-aux
+                       #'%unary-truncate))
+
 (defoptimizer (%unary-ftruncate derive-type) ((number))
   (let ((divisor (specifier-type '(integer 1 1))))
     (one-arg-derive-type number

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 81f7f5f..de92498 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3253,14 +3253,27 @@
                            (truncate x))))
         (d (compile nil `(lambda (x)
                            (declare (double-float x))
-                           (truncate x)))))
+                           (truncate x))))
+        (s-inlined (compile nil '(lambda (x)
+                                  (declare (type (single-float 0.0s0 1.0s0) x))
+                                  (truncate x))))
+        (d-inlined (compile nil '(lambda (x)
+                                  (declare (type (double-float 0.0d0 1.0d0) x))
+                                  (truncate x)))))
     ;; Check that there is no generic arithmetic
     (assert (not (search "GENERIC"
                          (with-output-to-string (out)
                            (disassemble s :stream out)))))
     (assert (not (search "GENERIC"
                          (with-output-to-string (out)
-                           (disassemble d :stream out)))))))
+                           (disassemble d :stream out)))))
+    ;; Check that we actually inlined the call when we were supposed to.
+    (assert (not (search "UNARY-TRUNCATE"
+                         (with-output-to-string (out)
+                           (disassemble s-inlined :stream out)))))
+    (assert (not (search "UNARY-TRUNCATE"
+                         (with-output-to-string (out)
+                           (disassemble d-inlined :stream out)))))))
 
 (with-test (:name :make-array-unnamed-dimension-leaf)
   (let ((fun (compile nil `(lambda (stuff)

diff --git a/version.lisp-expr b/version.lisp-expr
index cd163e5..7f48f79 100644 (file)
--- 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.34.10"
+"1.0.34.11"