sleep: Add more precautions to avoid consing on x86.

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 6eb9227..d6c5427 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -164,12 +164,12 @@ means to wait indefinitely.")
 
 (defun split-seconds-for-sleep (seconds)
   (declare (optimize speed))
+  ;; KLUDGE: This whole thing to avoid consing floats
   (flet ((split-float ()
-           ;; KLUDGE: This whole thing to avoid consing floats
            (let ((whole-seconds (truly-the fixnum (%unary-truncate seconds))))
              (values whole-seconds
                      (truly-the fixnum
-                                (%unary-truncate (* (- seconds whole-seconds)
+                                (%unary-truncate (* (- seconds (float whole-seconds))
                                                     (load-time-value 1s9 t))))))))
     (declare (inline split-float))
     (typecase seconds
@@ -181,7 +181,11 @@ means to wait indefinitely.")
        (multiple-value-bind (quot rem) (truncate (numerator seconds)
                                                  (denominator seconds))
          (values quot
-                 (* rem (truncate 1000000000 (denominator seconds))))))
+                 (* rem
+                    (if (typep 1000000000 'fixnum)
+                        (truncate 1000000000 (denominator seconds))
+                        ;; Can't truncate a bignum by a fixnum without consing
+                        (* 10 (truncate 100000000 (denominator seconds))))))))
       (t
        (multiple-value-bind (sec frac)
            (truncate seconds)

diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp
index 2a5c3d6..90d58f9 100644 (file)
--- a/tests/interface.pure.lisp
+++ b/tests/interface.pure.lisp
@@ -73,7 +73,7 @@
   (locally (declare (notinline sleep))
     (ctu:assert-no-consing (sleep 0.00001s0))
     (ctu:assert-no-consing (sleep 0.00001d0))
-    (ctu:assert-no-consing (sleep 1/100000000000000))))
+    (ctu:assert-no-consing (sleep 1/100000003))))
 
 ;;; SLEEP should work with large integers as well
 (with-test (:name (sleep pretty-much-forever))