From f77e81ba7736fc7df9ca7d37b93f662f36dae39f Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Mon, 3 Jun 2013 14:46:30 +0400 Subject: [PATCH] sleep: Add more precautions to avoid consing on x86. --- src/code/toplevel.lisp | 10 +++++++--- tests/interface.pure.lisp | 2 +- 2 files changed, 8 insertions(+), 4 deletions(-) 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)) -- 1.7.10.4