From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 25 Jun 2009 10:32:55 +0000 (+0000)
Subject: 1.0.29.39: SLEEP on large integers
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=237ec432952f0e7d4a4bcd5f683942a253cac56a;p=sbcl.git

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.
---

diff --git a/NEWS b/NEWS
index 219257d..68c9042 100644
--- a/NEWS
+++ b/NEWS
@@ -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
diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 419e8a1..66b0b3f 100644
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -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
diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 00d78a0..759f06e 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -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
diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp
index 285ddcb..81a987b 100644
--- a/tests/interface.pure.lisp
+++ b/tests/interface.pure.lisp
@@ -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)
diff --git a/version.lisp-expr b/version.lisp-expr
index 467aa95..a87f76c 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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"