X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=2f4e9e65915ca3c7389a5687e9d3f79975dcb3ef;hb=522a3c95b9b7a044ff0ab8df1ca29460ef2ad3a7;hp=a759017fbb199814738ebfbbf6ac985127d885a1;hpb=152c97de336af584a9b133207a772c704e3245cf;p=sbcl.git diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index a759017..2f4e9e6 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) @@ -291,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) @@ -435,39 +426,26 @@ :format-arguments (list note-format (list pathname) (strerror errno)))) -(defun stream-decoding-error (stream octets) - (error 'stream-decoding-error - :external-format (stream-external-format stream) - :stream stream - ;; FIXME: dunno how to get at OCTETS currently, or even if - ;; that's the right thing to report. - :octets octets)) -(defun stream-encoding-error (stream code) - (error 'stream-encoding-error - :external-format (stream-external-format stream) - :stream stream - :code code)) - (defun c-string-encoding-error (external-format code) (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. (defun stream-decoding-error-and-handle (stream octet-count) (restart-case - (stream-decoding-error stream - (let* ((buffer (fd-stream-ibuf stream)) - (sap (buffer-sap buffer)) - (head (buffer-head buffer))) - (loop for i from 0 below octet-count - collect (sap-ref-8 sap (+ head i))))) + (error 'stream-decoding-error + :external-format (stream-external-format stream) + :stream stream + :octets (let ((buffer (fd-stream-ibuf stream))) + (sap-ref-octets (buffer-sap buffer) + (buffer-head buffer) + octet-count))) (attempt-resync () :report (lambda (stream) (format stream @@ -499,7 +477,10 @@ (defun stream-encoding-error-and-handle (stream code) (restart-case - (stream-encoding-error stream code) + (error 'stream-encoding-error + :external-format (stream-external-format stream) + :stream stream + :code code) (output-nothing () :report (lambda (stream) (format stream "~@")) @@ -1098,7 +1079,9 @@ (catch 'eof-input-catcher (setf decode-break-reason (block decode-break-reason - (input-at-least ,stream-var ,(if (consp bytes) (car bytes) `(setq size ,bytes))) + (input-at-least ,stream-var ,(if (consp bytes) + (car bytes) + `(setq size ,bytes))) (let* ((byte (sap-ref-8 (buffer-sap ibuf) (buffer-head ibuf)))) (declare (ignorable byte)) ,@(when (consp bytes) @@ -1598,12 +1581,15 @@ (setf decode-break-reason (block decode-break-reason (setf byte (sap-ref-8 sap head) - size ,(if (consp in-size-expr) (cadr in-size-expr) in-size-expr) + size ,(if (consp in-size-expr) + (cadr in-size-expr) + in-size-expr) char ,in-expr) (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))) @@ -1617,12 +1603,15 @@ (setf decode-break-reason (block decode-break-reason (setf byte (sap-ref-8 sap head) - size ,(if (consp in-size-expr) (cadr in-size-expr) in-size-expr) + size ,(if (consp in-size-expr) + (cadr in-size-expr) + in-size-expr) char ,in-expr) (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) @@ -2424,6 +2413,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