Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
nikodemus committed Jun 25, 2009
1 parent 6dc30be commit 237ec43
Show file tree
Hide file tree
Showing 5 changed files with 30 additions and 14 deletions.
3 changes: 3 additions & 0 deletions NEWS
Expand Up @@ -41,6 +41,9 @@
anymore.
* bug fix: GENTEMP is now unaffected by pretty printer dispatch table.
(thanks to Alex Plotnick)
* bug fix: SLEEP accepts large integer arguments, truncating them to
SIGNED-WORD on the assumption that sleeping for 68 years is sufficient
for anyone. (reported by Leslie Polzer, thanks to Stas Boukarev)

changes in sbcl-1.0.29 relative to 1.0.28:
* IMPORTANT: bug database has moved from the BUGS file to Launchpad
Expand Down
26 changes: 14 additions & 12 deletions src/code/toplevel.lisp
Expand Up @@ -156,27 +156,29 @@ command-line.")

;;;; 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
Expand Down
2 changes: 1 addition & 1 deletion src/compiler/main.lisp
Expand Up @@ -778,7 +778,7 @@
(print-unreadable-object (s stream :type t))))
(:copier nil))
;; the UT that compilation started at
(start-time (get-internal-real) :type unsigned-byte)
(start-time (get-universal-time) :type unsigned-byte)
;; the IRT that compilation started at
(start-real-time (get-internal-real-time) :type unsigned-byte)
;; the FILE-INFO structure for this compilation
Expand Down
11 changes: 11 additions & 0 deletions tests/interface.pure.lisp
Expand Up @@ -63,6 +63,17 @@
(sleep 2)
(sleep 2))))

;;; SLEEP should work with large integers as well -- no timers
;;; on win32, so don't test there.
#-win32
(with-test (:name (sleep pretty-much-forever))
(assert (eq :timeout
(handler-case
(sb-ext:with-timeout 1
(sleep (ash 1 (* 2 sb-vm:n-word-bits))))
(sb-ext:timeout ()
:timeout)))))

;;; DOCUMENTATION should return nil, not signal slot-unbound
(documentation 'fixnum 'type)
(documentation 'class 'type)
Expand Down
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -17,4 +17,4 @@
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
"1.0.29.38"
"1.0.29.39"

0 comments on commit 237ec43

Please sign in to comment.