projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
sb-bsd-sockets: Fix type of canonname in addrinfo.
[sbcl.git]
/
src
/
code
/
toplevel.lisp
diff --git
a/src/code/toplevel.lisp
b/src/code/toplevel.lisp
index
97199db
..
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))
(defun split-seconds-for-sleep (seconds)
(declare (optimize speed))
+ ;; KLUDGE: This whole thing to avoid consing floats
(flet ((split-float ()
(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
(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
(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
(multiple-value-bind (quot rem) (truncate (numerator seconds)
(denominator seconds))
(values quot
- (* 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)
(t
(multiple-value-bind (sec frac)
(truncate seconds)