From e90d27e2998a6c97499f28a0a0b7a0cd2c43a447 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 20 May 2007 11:34:59 +0000 Subject: [PATCH] 1.0.5.55: interrupt safe REFILL-BUFFER/FD * Check for blocking / wait for new input before touching the stream. * Check that the SAP is still there after the wait, in case an interrupt handler or an FD handler closed the stream from under us. * Wrap the main action in WITHOUT-INTERRUPTS to prevent asynch unwinds from leaving the stream in an inconsistent state. (Since the read is going to be non-blocking it should be over soon enough.) * Arrange to signal errors outside the WITHOUT-INTERRUPTS. --- src/code/fd-stream.lisp | 123 ++++++++++++++++++++++++++++-------------------- version.lisp-expr | 2 +- 2 files changed, 73 insertions(+), 52 deletions(-) diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 2ae6c9a2a..ed1140d0b 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -718,59 +718,80 @@ stream errno))))) -;;; Fill the input buffer, and return the number of bytes read. Throw -;;; to EOF-INPUT-CATCHER if the eof was reached. Drop into -;;; SYSTEM:SERVER if necessary. +;;; If the read would block wait (using SERVE-EVENT) till input is available, +;;; then fill the input buffer, and return the number of bytes read. Throws +;;; to EOF-INPUT-CATCHER if the eof was reached. (defun refill-buffer/fd (stream) (let ((fd (fd-stream-fd stream)) - (ibuf-sap (fd-stream-ibuf-sap stream)) - (buflen (fd-stream-ibuf-length stream)) - (head (fd-stream-ibuf-head stream)) - (tail (fd-stream-ibuf-tail stream))) - (declare (type index head tail)) - (unless (zerop head) - (cond ((eql head tail) - (setf head 0) - (setf tail 0) - (setf (fd-stream-ibuf-head stream) 0) - (setf (fd-stream-ibuf-tail stream) 0)) - (t - (decf tail head) - (system-area-ub8-copy ibuf-sap head - ibuf-sap 0 tail) - (setf head 0) - (setf (fd-stream-ibuf-head stream) 0) - (setf (fd-stream-ibuf-tail stream) tail)))) - (setf (fd-stream-listen stream) nil) - ;;This isn't quite the same on win32. Then again, neither was - ;;(not (sb!win32:fd-listen fd)), as was originally here. See - ;;comment in `sysread-may-block-p'. - (when (sysread-may-block-p stream) - (unless (wait-until-fd-usable - fd :input (fd-stream-timeout stream)) - (signal-timeout 'io-timeout :stream stream :direction :read - :seconds (fd-stream-timeout stream)))) - (multiple-value-bind (count errno) - (sb!unix:unix-read fd - (int-sap (+ (sap-int ibuf-sap) tail)) - (- buflen tail)) - (cond ((null count) - (if #!-win32 (eql errno sb!unix:ewouldblock) #!+win32 t #!-win32 - (progn - (unless (wait-until-fd-usable - fd :input (fd-stream-timeout stream)) - (signal-timeout 'io-timeout - :stream stream :direction :read - :seconds (fd-stream-timeout stream))) - (refill-buffer/fd stream)) - (simple-stream-perror "couldn't read from ~S" stream errno))) - ((zerop count) - (setf (fd-stream-listen stream) :eof) - (/show0 "THROWing EOF-INPUT-CATCHER") - (throw 'eof-input-catcher nil)) - (t - (incf (fd-stream-ibuf-tail stream) count) - count))))) + (errno 0) + (count 0)) + (tagbody + ;; Check for blocking input before touching the stream, as if + ;; we happen to wait we are liable to be interrupted, and the + ;; interrupt handler may use the same stream. + (if (sysread-may-block-p stream) + (go :wait-for-input) + (go :main)) + ;; These (:CLOSED-FLAME and :READ-ERROR) tags are here so what + ;; we can signal errors outside the WITHOUT-INTERRUPTS. + :closed-flame + (closed-flame stream) + :read-error + (simple-stream-perror "couldn't read from ~S" stream errno) + :wait-for-input + ;; This tag is here so we can unwind outside the WITHOUT-INTERRUPTS + ;; to wait for input if read tells us EWOULDBLOCK. + (unless (wait-until-fd-usable fd :input (fd-stream-timeout stream)) + (signal-timeout 'io-timeout :stream stream :direction :read + :seconds (fd-stream-timeout stream))) + :main + ;; Since the read should not block, we'll disable the + ;; interrupts here, so that we don't accidentally unwind and + ;; leave the stream in an inconsistent state. + (without-interrupts + (let ((ibuf-sap (fd-stream-ibuf-sap stream)) + (buflen (fd-stream-ibuf-length stream)) + (head (fd-stream-ibuf-head stream)) + (tail (fd-stream-ibuf-tail stream))) + (declare (type index head tail)) + ;; Check the SAP: if it is null, then someone has closed + ;; the stream from underneath us. This is not ment to fix + ;; multithreaded races, but to deal with interrupt handlers + ;; closing the stream. + (unless ibuf-sap + (go :closed-flame)) + (unless (zerop head) + (cond ((eql head tail) + (setf head 0 + tail 0 + (fd-stream-ibuf-head stream) 0 + (fd-stream-ibuf-tail stream) 0)) + (t + (decf tail head) + (system-area-ub8-copy ibuf-sap head + ibuf-sap 0 tail) + (setf head 0 + (fd-stream-ibuf-head stream) 0 + (fd-stream-ibuf-tail stream) tail)))) + (setf (fd-stream-listen stream) nil) + (setf (values count errno) + (sb!unix:unix-read fd (int-sap (+ (sap-int ibuf-sap) tail)) + (- buflen tail))) + (cond ((null count) + #!+win32 + (go :read-error) + #!-win32 + (if (eql errno sb!unix:ewouldblock) + (go :wait-for-input) + (go :read-error))) + ((zerop count) + (setf (fd-stream-listen stream) :eof) + (/show0 "THROWing EOF-INPUT-CATCHER") + (throw 'eof-input-catcher nil)) + (t + ;; Success! + (incf (fd-stream-ibuf-tail stream) count)))))) + count)) ;;; Make sure there are at least BYTES number of bytes in the input ;;; buffer. Keep calling REFILL-BUFFER/FD until that condition is met. diff --git a/version.lisp-expr b/version.lisp-expr index 66592957e..b49a5d685 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.5.54" +"1.0.5.55" -- 2.11.4.GIT