From 1615ff35271eab3985280560ceae89a64af98346 Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Sat, 23 Aug 2008 19:17:35 +0200 Subject: [PATCH] Small fixes to timeout handling in POll-FD. Signed-off-by: Stelian Ionescu --- io.streams/zeta/device.lisp | 2 +- io.streams/zeta/ffi-functions-unix.lisp | 21 +++++++-------------- 2 files changed, 8 insertions(+), 15 deletions(-) diff --git a/io.streams/zeta/device.lisp b/io.streams/zeta/device.lisp index fdf858b..cc31ef0 100644 --- a/io.streams/zeta/device.lisp +++ b/io.streams/zeta/device.lisp @@ -27,7 +27,7 @@ (protocol :initarg :protocol))) (deftype device-timeout () - `(or null non-negative-real)) + 'non-negative-real) (deftype stream-position () '(unsigned-byte 64)) diff --git a/io.streams/zeta/ffi-functions-unix.lisp b/io.streams/zeta/ffi-functions-unix.lisp index cc36fd7..ce83767 100644 --- a/io.streams/zeta/ffi-functions-unix.lisp +++ b/io.streams/zeta/ffi-functions-unix.lisp @@ -26,11 +26,9 @@ (values readp writep)))) (defun timeout->milisec (timeout) - (if timeout - (multiple-value-bind (sec usec) - (decode-timeout timeout) - (+ (* sec 1000) (truncate usec 1000))) - -1)) + (multiple-value-bind (sec usec) + (decode-timeout timeout) + (+ (* sec 1000) (truncate usec 1000)))) (defun %poll (fds timeout) (repeat-upon-condition-decreasing-timeout @@ -39,7 +37,7 @@ (defun poll-fd (fd event-type timeout) "Poll file descriptor `FD' for I/O readiness. `EVENT-TYPE' must be either :INPUT, :OUTPUT or :IO. -`TIMEOUT' must be either a non-negative integer measured in seconds, or `NIL' meaning no timeout at all. +`TIMEOUT' must be a non-negative integer measured in seconds. If a timeout occurs `POLL-TIMEOUT' is signaled. Returns two boolean values indicating readability and writeability of `FD'." (flet ((poll-error (posix-err) @@ -59,9 +57,6 @@ Returns two boolean values indicating readability and writeability of `FD'." (t (error 'poll-timeout :os-handle fd :event-type event-type))) (posix-error (err) (poll-error err))))))) - -(defun poll-file (file-descriptor event-type timeout) - (poll-fd file-descriptor event-type timeout)) ;;;----------------------------------------------------------------------------- @@ -116,14 +111,13 @@ Returns two boolean values indicating readability and writeability of `FD'." (type device-timeout timeout) (special *device*)) (with-pointer-to-vector-data (buf vector) - (repeat-decreasing-timeout (remaining timeout :rloop) + (repeat-decreasing-timeout (remaining (clamp-timeout timeout) :rloop) (flet ((check-timeout () (if (plusp remaining) - (poll fd :input remaining) + (poll-fd fd :input remaining) (return-from :rloop 0)))) (handler-case (%sys-read fd (inc-pointer buf start) (- end start)) - (eintr () (check-timeout)) (ewouldblock () (check-timeout)) (posix-error (err) (posix-file-error err *device* "reading data from")) @@ -156,14 +150,13 @@ Returns two boolean values indicating readability and writeability of `FD'." (type device-timeout timeout) (special *device*)) (with-pointer-to-vector-data (buf vector) - (repeat-decreasing-timeout (remaining timeout :rloop) + (repeat-decreasing-timeout (remaining (clamp-timeout timeout) :rloop) (flet ((check-timeout () (if (plusp remaining) (poll-fd fd :output remaining) (return-from :rloop 0)))) (handler-case (%sys-write fd (inc-pointer buf start) (- end start)) - (eintr () (check-timeout)) (ewouldblock () (check-timeout)) (epipe () (return-from :rloop :eof)) (posix-error (err) -- 2.11.4.GIT