X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftoplevel.lisp;h=d6c542763e8497e04f447173e5287cca2b602148;hb=11aa29a68039d6fb3cf41d67352a6b263b1094b6;hp=1c00f03c67f9f6a8b0f4589cf656d5c8bb9a4e40;hpb=eb90b28e77fe78baebf3105a600a97969acfd995;p=sbcl.git

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 1c00f03..d6c5427 100644
--- 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
-                 (truncate (* rem (/ 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)