From: Stas Boukarev Date: Mon, 3 Jun 2013 10:46:30 +0000 (+0400) Subject: sleep: Add more precautions to avoid consing on x86. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f77e81ba7736fc7df9ca7d37b93f662f36dae39f;p=sbcl.git 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 --- 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 --- 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))