X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fserve-event.lisp;h=ca055edf437fb56635fe98eb300452ef9dea1b4d;hb=0dda5090b6c16a641000b4eb2dcd479f39b784ca;hp=e3563e66055fe9bcc1be23b5da70c47d45174ed0;hpb=fcdd5b05583258e43bfe22bdfaea1fc34f85289d;p=sbcl.git diff --git a/src/code/serve-event.lisp b/src/code/serve-event.lisp index e3563e6..ca055ed 100644 --- a/src/code/serve-event.lisp +++ b/src/code/serve-event.lisp @@ -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)) @@ -211,7 +205,8 @@ waiting." (loop for to-msec = (if (and to-sec to-usec) (+ (* 1000 to-sec) (truncate to-usec 1000)) -1) - when (sb!unix:unix-simple-poll fd direction to-msec) + when (or #!+win32 (eq direction :output) + (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)))))))) @@ -322,7 +317,11 @@ happens. Server returns T if something happened and NIL otherwise. Timeout (ecase (handler-direction handler) (:input (sb!unix:fd-isset fd read-fds)) (:output (sb!unix:fd-isset fd write-fds))))))) - (funcall (handler-function handler) - (handler-descriptor handler))) + (with-simple-restart (remove-fd-handler "Remove ~S" handler) + (funcall (handler-function handler) + (handler-descriptor handler)) + (go :next)) + (remove-fd-handler handler) + :next) t))))))