From: Nikodemus S. <de...@us...> - 2009-06-25 10:33:05
|
Update of /cvsroot/sbcl/sbcl/src/code In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv23135/src/code Modified Files: toplevel.lisp Log Message: 1.0.29.39: SLEEP on large integers * Truncate arguments to nanosleep to SIGNED-WORD -- sleeping for 68 years should be enough for anyone. (reported by Leslie Polzer, patch by Stas Boukarev) * Also fix a snafu from the last commit: GET-UNIVERSAL-TIME, not GET-INTERNAL-REAL. Feh. Index: toplevel.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/toplevel.lisp,v retrieving revision 1.106 retrieving revision 1.107 diff -u -d -r1.106 -r1.107 --- toplevel.lisp 22 Jun 2009 12:58:23 -0000 1.106 +++ toplevel.lisp 25 Jun 2009 10:32:56 -0000 1.107 @@ -156,27 +156,29 @@ ;;;; miscellaneous external functions -(defun sleep (n) +(defun sleep (seconds) #!+sb-doc - "This function causes execution to be suspended for N seconds. N may - be any non-negative, non-complex number." - (when (or (not (realp n)) - (minusp n)) + "This function causes execution to be suspended for SECONDS. SECONDS may be +any non-negative real number." + (when (or (not (realp seconds)) + (minusp seconds)) (error 'simple-type-error :format-control "invalid argument to SLEEP: ~S" - :format-arguments (list n) - :datum n + :format-arguments (list seconds) + :datum seconds :expected-type '(real 0))) #!-win32 (multiple-value-bind (sec nsec) - (if (integerp n) - (values n 0) + (if (integerp seconds) + (values seconds 0) (multiple-value-bind (sec frac) - (truncate n) + (truncate seconds) (values sec (truncate frac 1e-9)))) - (sb!unix:nanosleep sec nsec)) + ;; nanosleep accepts time_t as the first argument, + ;; so truncating is needed. 68 years on 32-bit platform should be enough + (sb!unix:nanosleep (min sec (1- (ash 1 (1- sb!vm:n-word-bits)))) nsec)) #!+win32 - (sb!win32:millisleep (truncate (* n 1000))) + (sb!win32:millisleep (truncate (* seconds 1000))) nil) ;;;; the default toplevel function |