Changeset 11831

Timestamp:

Mar 20, 2009, 11:01:03 AM (10 years ago)

Author:

gb

Message:

r11827 (Windows I/O timeouts) to 1.3.

File:

• release/1.3/source/level-1/l1-streams.lisp (modified) (2 diffs)

release/1.3/source/level-1/l1-streams.lisp

@@ -5377 +5377 @@
 
 (defun fd-input-available-p (fd &optional milliseconds)
-  #+windows-target (declare (ignore fd milliseconds))
-  #+windows-target nil
+  #+windows-target
+  (case (%unix-fd-kind fd)
+    (:socket
+     (rlet ((infds #>fd_set)
+            (tv :timeval :tv_sec 0 :tv_usec 0))
+       (fd-zero infds)
+       (fd-set fd infds)
+       (when milliseconds
+         (multiple-value-bind (seconds millis)
+             (floor milliseconds 1000)
+        (setf (pref tv :timeval.tv_sec) seconds
+              (pref tv :timeval.tv_usec) (* 1000 millis))))
+       (let* ((result (#_select 1 infds (%null-ptr) (%null-ptr) (if milliseconds tv (%null-ptr)))))
+         (cond ((> result 0) (values t 0))
+               ((= result 0) (values nil 0))
+               (t (values nil (- (#_GetLastError))))))))
+    (:pipe (if (data-available-on-pipe-p fd)
+             (values t 0)
+             (if (and milliseconds (> milliseconds 0))
+               (values (process-wait-with-timeout "input-wait" milliseconds #'data-available-on-pipe-p fd) 0)
+               (values nil 0))))
+    ;(:character-special (windows-tty-input-available-p fd milliseconds))
+    (t (values nil 0)))
   #-windows-target
   (rlet ((pollfds (:array (:struct :pollfd) 1)))
@@ -5389 +5410 @@
 
 (defun fd-ready-for-output-p (fd &optional milliseconds)
-  #+windows-target (declare (ignore fd milliseconds))
-  #+windows-target t
+  #+windows-target
+  (case (%unix-fd-kind fd)
+    (:socket
+     (rlet ((tv :timeval :tv_sec 0 :tv_usec 0)
+            (outfds :fd_set))
+       (fd-zero outfds)
+       (fd-set fd outfds)
+       (when milliseconds
+         (multiple-value-bind (seconds millis)
+             (floor milliseconds 1000)
+           (setf (pref tv #>timeval.tv_sec) seconds
+                 (pref tv #>timeval.tv_usec) (* millis 1000))))
+       (let* ((res (#_select 1 (%null-ptr) outfds (%null-ptr) (if milliseconds tv (%null-ptr)))))
+         (cond ((> res 0) (values t 0))
+               ((= res 0) (values nil 0))
+               (t (values 0 (- (#_GetLastError))))))))
+    (t (values t 0)))
   #-windows-target
   (rlet ((pollfds (:array (:struct :pollfd) 1)))