Teach RTL compression to search through object->float too.

This way it can fold (object->float (constant #x1p+0)) in both

(assign (register #x22) (object->float (constant #x1p+0))
(assign (register #x23) (offset (register 4) (machine-constant 0)))
(assign (register #x24) (object->float (register #x23)))
(jumpc (flonum-pred-2-args flonum-is-greater? (register #x22) (register #x24)) label-3)

and

(assign (register #x21) (offset (register 4) (machine-constant 0)))
(assign (register #x22) (object->float (register #x21)))
(assign (register #x24) (object->float (constant #x1p+0)))
(jumpc (flonum-pred-2-args flonum-is-greater? (register #x22) (register #x24)) label-3)

where previously it could handle only the second one because the
reference appeared in the immediately subsequent instruction.

This exposes a latent bug in the x86-64 code generator, to be fixed
in a subsequent commit.

diff --git a/src/compiler/rtlopt/rcompr.scm b/src/compiler/rtlopt/rcompr.scm
index 15d702c983cd2e8cf22fc681b391ab2218327677..755111d88a33df1235cc2d832b68e10fe0cac2f1 100644 (file)
--- a/src/compiler/rtlopt/rcompr.scm
+++ b/src/compiler/rtlopt/rcompr.scm
@@ -204,6 +204,9 @@ USA.
              ((rtl:object->unsigned-fixnum? expression)
               (recursion rtl:object->unsigned-fixnum-expression
                          rtl:make-object->unsigned-fixnum))
+             ((rtl:object->float? expression)
+              (recurse-and-search rtl:object->float-expression
+                                  rtl:make-object->float))
              (else
               (values false false)))))))
 \f

diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index 83c5f3cc0959f2c79d3a2bb73f3ccdaeccb0c9e0..84a0421232c610cc60ebd9b890703b407804559e 100644 (file)
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -335,6 +335,12 @@ USA.
        (define-lconstcomp-test (symbol name '/lconst) safe unsafe x0 cases)
        (define-rconstcomp-test (symbol name '/rconst) safe unsafe x0 cases)))))
 
+(define expect-failure-x86-64
+  (if (and (eq? microcode-id/compiled-code-type 'x86-64)
+           (compiled-procedure? (lambda (x) x)))
+      expect-failure
+      #!default))
+
 (define-constcomp-test '< flo:safe< flo:< 0.
   `((-inf.0 #f #t)
     (-1. #f #t)
@@ -368,7 +374,18 @@ USA.
     (+inf.0 #t #f)
     (+nan.0 #f #f)))
 
-(define-constcomp-test '>= flo:safe>= flo:>= 0.
+(define-lconstcomp-test '>=/lconst flo:safe>= flo:>= 0.
+  `((-inf.0 #t #f ,expect-failure-x86-64)
+    (-1. #t #f ,expect-failure-x86-64)
+    (,subnormal- #t #f ,expect-failure-x86-64)
+    (-0. #t #t)
+    (+0. #t #t)
+    (,subnormal+ #f #t ,expect-failure-x86-64)
+    (+1. #f #t ,expect-failure-x86-64)
+    (+inf.0 #f #t ,expect-failure-x86-64)
+    (+nan.0 #f #f)))
+
+(define-rconstcomp-test '>=/rconst flo:safe>= flo:>= 0.
   `((-inf.0 #t #f)
     (-1. #t #f)
     (,subnormal- #t #f)
@@ -423,7 +440,18 @@ USA.
     (+inf.0 #t #f)
     (+nan.0 #f #f)))
 
-(define-constcomp-test '>= flo:safe>= flo:>= 1.
+(define-lconstcomp-test '>=/lconst flo:safe>= flo:>= 1.
+  `((-inf.0 #t #f ,expect-failure-x86-64)
+    (-1. #t #f ,expect-failure-x86-64)
+    (,subnormal- #t #f ,expect-failure-x86-64)
+    (-0. #t #f ,expect-failure-x86-64)
+    (+0. #t #f ,expect-failure-x86-64)
+    (,subnormal+ #t #f ,expect-failure-x86-64)
+    (+1. #t #t)
+    (+inf.0 #f #t ,expect-failure-x86-64)
+    (+nan.0 #f #f)))
+
+(define-rconstcomp-test '>=/rconst flo:safe>= flo:>= 1.
   `((-inf.0 #t #f)
     (-1. #t #f)
     (,subnormal- #t #f)