X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fserve-event.lisp;h=b1a6eedca9364c9cb1c87ec298b35e29b459c06c;hb=9303b3dc86bdfe5193b403de7419dc5bc8cc79e4;hp=2faa4013daa471bae4f37ad247ee7377721a98fc;hpb=3ccd2c124ae60833f54406a2b478d13835e4b7df;p=sbcl.git

diff --git a/src/code/serve-event.lisp b/src/code/serve-event.lisp
index 2faa401..b1a6eed 100644
--- a/src/code/serve-event.lisp
+++ b/src/code/serve-event.lisp
@@ -66,7 +66,7 @@
 ;;; Add a new handler to *descriptor-handlers*.
 (defun add-fd-handler (fd direction function)
   #!+sb-doc
-  "Arange to call FUNCTION whenever FD is usable. DIRECTION should be
+  "Arrange to call FUNCTION whenever FD is usable. DIRECTION should be
   either :INPUT or :OUTPUT. The value returned should be passed to
   SYSTEM:REMOVE-FD-HANDLER when it is no longer needed."
   (unless (member direction '(:input :output))
@@ -90,8 +90,8 @@
 ;;; Search *descriptor-handlers* for any reference to fd, and nuke 'em.
 (defun invalidate-descriptor (fd)
   #!+sb-doc
-  "Remove any handers refering to fd. This should only be used when attempting
-  to recover from a detected inconsistancy."
+  "Remove any handlers referring to FD. This should only be used when attempting
+  to recover from a detected inconsistency."
   (with-descriptor-handlers
     (setf *descriptor-handlers*
           (delete fd *descriptor-handlers*
@@ -175,15 +175,9 @@ waiting."
        (flet ((maybe-update-timeout ()
                 ;; If we return early, recompute the timeouts, possibly
                 ;; signaling the deadline or returning with NIL to caller.
-                (multiple-value-bind (sec usec)
-                    (decode-internal-time (get-internal-real-time))
-                  (setf to-sec (- stop-sec sec))
-                  (cond ((> usec stop-usec)
-                         (decf to-sec)
-                         (setf to-usec (- (+ stop-usec 1000000) usec)))
-                        (t
-                         (setf to-usec (- stop-usec usec)))))
-                (when (or (minusp to-sec) (and (zerop to-sec) (not (plusp to-usec))))
+                (setf (values to-sec to-usec)
+                      (relative-decoded-times stop-sec stop-usec))
+                (when (and (zerop to-sec) (not (plusp to-usec)))
                   (cond (signalp
                          (signal-deadline)
                          (go :restart))
@@ -212,10 +206,14 @@ waiting."
                                      (+ (* 1000 to-sec) (truncate to-usec 1000))
                                      -1)
                    when (or #!+win32 (eq direction :output)
+                            #!+win32 (sb!win32:handle-listen
+                                      (sb!win32:get-osfhandle fd))
+                            #!-win32
                             (sb!unix:unix-simple-poll fd direction to-msec))
                    do (return-from wait-until-fd-usable t)
                    else
-                   do (when to-sec (maybe-update-timeout))))))))
+                   do (when to-sec (maybe-update-timeout))
+                   #!+win32 (sb!thread:thread-yield)))))))
 
 ;;; Wait for up to timeout seconds for an event to happen. Make sure all
 ;;; pending events are processed before returning.