Changeset 7971 for branches/1.2-devel/ccl/level-1/l1-streams.lisp

Timestamp:

Jan 1, 2008, 1:36:11 AM (13 years ago)

Author:

gb

Message:

Fix typo in BROADCAST-STREAM stream-write-list method name.

Define PROCESS-INPUT-WOULD-BLOCK, PROCESS-OUTPUT-WOULD-BLOCK.

Default FD-STREAM-ADVANCE method: don't wait, if we can assume
that the FD-READ can be interrupted.

File:

• branches/1.2-devel/ccl/level-1/l1-streams.lisp (modified) (5 diffs)

branches/1.2-devel/ccl/level-1/l1-streams.lisp

@@ -4089 +4089 @@
              (broadcast-method stream-force-output (s))
              (broadcast-method stream-finish-output (s))
-             (broadcast-method stream-stream-write-list (s l c))
+             (broadcast-method stream-write-list (s l c))
              (broadcast-method stream-write-vector (s v start end)))
 
@@ -5201 +5201 @@
                                  :unsigned-fullword)))))
 
+(defun process-input-would-block (fd)
+  (if (logtest #$O_NONBLOCK (the fixnum (fd-get-flags fd)))
+    (process-input-wait fd)
+    (- #$ETIMEDOUT)))
+    
 (defun process-input-wait (fd &optional ticks)
   "Wait until input is available on a given file-descriptor."
@@ -5221 +5226 @@
 
 
+(defun process-output-would-block (fd)
+  (if (logtest #$O_NONBLOCK (the fixnum (fd-get-flags fd)))
+    (process-output-wait fd)
+    (- #$ETIMEDOUT)))
 
 (defun process-output-wait (fd)
@@ -5348 +5357 @@
           (io-buffer-count buf) 0
           (ioblock-eof ioblock) nil)
-    (let* ((avail nil))
-      (when (or read-p (setq avail (stream-listen s)))
-        (if (and (ioblock-interactive ioblock)
-                 (not avail))
-          (process-input-wait fd))
+      (when (or read-p (stream-listen s))
         (let* ((n (with-eagain fd :input
                     (fd-read fd bufptr size))))
@@ -5362 +5367 @@
                     (ioblock-octets-to-elements ioblock n))
               (progn (setf (ioblock-eof ioblock) t)
-                     nil))))))))
+                     nil)))))))
 
 (defun fd-stream-eofp (s ioblock)