Skip to content
Snippets Groups Projects
Commit baa7e9b3 authored by dtc's avatar dtc
Browse files

Use mp:process-wait-until-fd-usable with the MP feature to avoid

stream input blocking when there are other runnable processes.
parent 9e78a0f2
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.41 1997/12/27 12:33:07 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.42 1998/01/04 22:46:41 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -484,23 +484,27 @@ ...@@ -484,23 +484,27 @@
(case count (case count
(1) (1)
(0 (0
(unless (system:wait-until-fd-usable (unless #-mp (system:wait-until-fd-usable
fd :input (fd-stream-timeout stream)) fd :input (fd-stream-timeout stream))
#+mp (mp:process-wait-until-fd-usable
fd :input (fd-stream-timeout stream))
(error 'io-timeout :stream stream :direction :read))) (error 'io-timeout :stream stream :direction :read)))
(t (t
(error "Problem checking to see if ~S is readable: ~A" (error "Problem checking to see if ~S is readable: ~A"
stream stream
(unix:get-unix-error-msg errno))))) (unix:get-unix-error-msg errno)))))
(multiple-value-bind (multiple-value-bind
(count errno) (count errno)
(unix:unix-read fd (unix:unix-read fd
(system:int-sap (+ (system:sap-int ibuf-sap) tail)) (system:int-sap (+ (system:sap-int ibuf-sap) tail))
(- buflen tail)) (- buflen tail))
(cond ((null count) (cond ((null count)
(if (eql errno unix:ewouldblock) (if (eql errno unix:ewouldblock)
(progn (progn
(unless (system:wait-until-fd-usable (unless #-mp (system:wait-until-fd-usable
fd :input (fd-stream-timeout stream)) fd :input (fd-stream-timeout stream))
#+mp (mp:process-wait-until-fd-usable
fd :input (fd-stream-timeout stream))
(error 'io-timeout :stream stream :direction :read)) (error 'io-timeout :stream stream :direction :read))
(do-input stream)) (do-input stream))
(error "Error reading ~S: ~A" (error "Error reading ~S: ~A"
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment