X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=311a4b990389bf74d9110527a352bf6beb440a95;hb=3f3033a6c0ddf0af8dd1b5a17c2a4b82ea59b94f;hp=a2940e14176b8d94c6725526043fe3e9268a1d29;hpb=765a042b5f968f285d8bd4a4ea1e897ca29abc8d;p=sbcl.git diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index a2940e1..311a4b9 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -52,25 +52,16 @@ #!+sb-doc "List of available buffers.") -(defvar *available-buffers-spinlock* (sb!thread::make-spinlock - :name "lock for *AVAILABLE-BUFFERS*") +(defvar *available-buffers-lock* (sb!thread:make-mutex + :name "lock for *AVAILABLE-BUFFERS*") #!+sb-doc "Mutex for access to *AVAILABLE-BUFFERS*.") (defmacro with-available-buffers-lock ((&optional) &body body) - ;; CALL-WITH-SYSTEM-SPINLOCK because - ;; - ;; 1. streams are low-level enough to be async signal safe, and in - ;; particular a C-c that brings up the debugger while holding the - ;; mutex would lose badly - ;; - ;; 2. this can potentially be a fairly busy (but also probably - ;; uncontended) lock, so we don't want to pay the syscall per - ;; release -- hence a spinlock. - ;; - ;; ...again, once we have smarted locks the spinlock here can become - ;; a mutex. - `(sb!thread::with-system-spinlock (*available-buffers-spinlock*) + ;; CALL-WITH-SYSTEM-MUTEX because streams are low-level enough to be + ;; async signal safe, and in particular a C-c that brings up the + ;; debugger while holding the mutex would lose badly. + `(sb!thread::with-system-mutex (*available-buffers-lock*) ,@body)) (defconstant +bytes-per-buffer+ (* 4 1024) @@ -157,6 +148,8 @@ (element-type 'base-char) ;; the Unix file descriptor (fd -1 :type fixnum) + ;; What do we know about the FD? + (fd-type :unknown :type keyword) ;; controls when the output buffer is flushed (buffering :full :type (member :full :line :none)) ;; controls whether the input buffer must be cleared before output @@ -289,9 +282,9 @@ (return (reset-buffer obuf))) (count ;; Partial write -- update buffer status and - ;; queue or wait. Do not use INCF! Another - ;; thread might have moved head... - (setf (buffer-head obuf) (+ count head)) + ;; queue or wait. + (incf head count) + (setf (buffer-head obuf) head) (queue-or-wait)) #!-win32 ((eql errno sb!unix:ewouldblock) @@ -407,14 +400,10 @@ ;;; this is not something we want to export. Nikodemus thinks the ;;; right thing is to support a low-level non-stream like IO layer, ;;; akin to java.nio. -(defun output-raw-bytes (stream thing &optional start end) +(declaim (inline output-raw-bytes)) +(define-deprecated-function :late "1.0.8.16" output-raw-bytes write-sequence + (stream thing &optional start end) (write-or-buffer-output stream thing (or start 0) (or end (length thing)))) - -(define-compiler-macro output-raw-bytes (stream thing &optional start end) - (deprecation-warning 'output-raw-bytes) - (let ((x (gensym "THING"))) - `(let ((,x ,thing)) - (write-or-buffer-output ,stream ,x (or ,start 0) (or ,end (length ,x)))))) ;;;; output routines and related noise @@ -454,11 +443,10 @@ (error 'c-string-encoding-error :external-format external-format :code code)) - -(defun c-string-decoding-error (external-format octets) +(defun c-string-decoding-error (external-format sap offset count) (error 'c-string-decoding-error :external-format external-format - :octets octets)) + :octets (sap-ref-octets sap offset count))) ;;; Returning true goes into end of file handling, false will enter another ;;; round of input buffer filling followed by re-entering character decode. @@ -974,11 +962,9 @@ (count 0)) (tagbody ;; Check for blocking input before touching the stream if we are to - ;; serve events: if the FD is blocking, we don't want to hang on the - ;; write if we are to serve events or notice timeouts. - (if (and (or (fd-stream-serve-events stream) - (fd-stream-timeout stream) - *deadline*) + ;; serve events: if the FD is blocking, we don't want to try an uninterruptible + ;; read(). Regular files should never block, so we can elide the check. + (if (and (neq :regular (fd-stream-fd-type stream)) (sysread-may-block-p stream)) (go :wait-for-input) (go :main)) @@ -1607,7 +1593,8 @@ (incf head size) nil)) (when decode-break-reason - (c-string-decoding-error ,name decode-break-reason)) + (c-string-decoding-error + ,name sap head decode-break-reason)) (when (zerop (char-code char)) (return count)))) (string (make-string length :element-type element-type))) @@ -1626,7 +1613,8 @@ (incf head size) nil)) (when decode-break-reason - (c-string-decoding-error ,name decode-break-reason)) + (c-string-decoding-error + ,name sap head decode-break-reason)) (setf (aref string index) char))))) (defun ,output-c-string-function (string) @@ -2221,6 +2209,12 @@ ((not (or input output)) (error "File descriptor must be opened either for input or output."))) (let ((stream (%make-fd-stream :fd fd + :fd-type (progn + #!-win32 (sb!unix:fd-type fd) + ;; KLUDGE. + #!+win32 (if serve-events + :unknown + :regular)) :name name :file file :original original @@ -2422,6 +2416,10 @@ (cond ((numberp fd) (case direction ((:input :output :io) + ;; For O_APPEND opened files, lseek returns 0 until first write. + ;; So we jump ahead here. + (when (eq if-exists :append) + (sb!unix:unix-lseek fd 0 sb!unix:l_xtnd)) (make-fd-stream fd :input input :output output