[Openmcl-cvs-notifications] r10829 - /trunk/source/lib/time.lisp

[gb at clozure.com]

Author: gb
Date: Mon Sep 22 11:17:57 2008
New Revision: 10829

Log:
Sleep interruptably/continuably on Windows.

Modified:
    trunk/source/lib/time.lisp

Modified: trunk/source/lib/time.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/time.lisp (original)
+++ trunk/source/lib/time.lisp Mon Sep 22 11:17:57 2008
@@ -210,9 +210,14 @@
       (nanoseconds seconds)
     (%nanosleep secs nanos))
   #+windows-target
-  (let* ((millis (round (* seconds 1000))))
-    (#_SleepEx millis 1)
-    nil))
+  (do* ((start (floor (get-internal-real-time)
+                       (floor internal-time-units-per-second 1000))
+               (floor (get-internal-real-time)
+                       (floor internal-time-units-per-second 1000)))
+         (millis (round (* seconds 1000)) (- stop start))
+         (stop (+ start millis)))
+       ((or (<=3D millis 0)
+            (not (eql (#_SleepEx millis #$true) #$WAIT_IO_COMPLETION))))))
 =

 =

 (defun %internal-run-time ()