X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=ef0c2c4f585ad24a42720d6c1eacf3398dde307a;hb=98c725660502dc1a761e60ac935f95ed60143021;hp=efa1d053be0962c210dc69df9fb593e2027da1df;hpb=df677c367a27b9d8cedd6371b7646567a972d4b3;p=sbcl.git diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index efa1d05..ef0c2c4 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -325,6 +325,7 @@ (intern (format nil name-fmt (string (car buffering)))))) `(progn (defun ,function (stream byte) + (declare (ignorable byte)) (output-wrapper/variable-width (stream ,size ,buffering ,restart) ,@body)) (setf *output-routines* @@ -752,6 +753,7 @@ ,stream-var) (fd-stream-ibuf-head ,stream-var)))) + (declare (ignorable byte)) (setq size ,bytes) (input-at-least ,stream-var size) (setq ,element-var (locally ,@read-forms)) @@ -1001,6 +1003,16 @@ (when sizer (loop for char across string summing (funcall sizer char))))) +(defun find-external-format (external-format) + (when external-format + (find external-format *external-formats* :test #'member :key #'car))) + +(defun variable-width-external-format-p (ef-entry) + (when (eighth ef-entry) t)) + +(defun bytes-for-char-fun (ef-entry) + (if ef-entry (symbol-function (ninth ef-entry)) (constantly 1))) + ;;; FIXME: OAOOM here vrt. *EXTERNAL-FORMAT-FUNCTIONS* in fd-stream.lisp (defmacro define-external-format (external-format size output-restart out-expr in-expr) @@ -1134,6 +1146,7 @@ (size-function (symbolicate "BYTES-FOR-CHAR/" name))) `(progn (defun ,size-function (byte) + (declare (ignorable byte)) ,out-size-expr) (defun ,out-function (stream string flush-p start end) (let ((start (or start 0)) @@ -1218,6 +1231,7 @@ (setf decode-break-reason (block decode-break-reason (let ((byte (sap-ref-8 sap head))) + (declare (ignorable byte)) (setq size ,in-size-expr) (when (> size (- tail head)) (return)) @@ -1262,6 +1276,7 @@ ,in-size-expr sap head) (let ((byte (sap-ref-8 sap head))) + (declare (ignorable byte)) ,in-expr)) (defun ,resync-function (stream) (loop (input-at-least stream 2) @@ -1271,6 +1286,7 @@ (head (fd-stream-ibuf-head stream)) (byte (sap-ref-8 sap head)) (size ,in-size-expr)) + (declare (ignorable byte)) (input-at-least stream size) (let ((sap (fd-stream-ibuf-sap stream)) (head (fd-stream-ibuf-head stream))) @@ -1582,33 +1598,36 @@ (declare (ignore arg2)) (case operation (:listen - (or (not (eql (fd-stream-ibuf-head fd-stream) - (fd-stream-ibuf-tail fd-stream))) - (fd-stream-listen fd-stream) - #!+win32 - (setf (fd-stream-listen fd-stream) - (sb!win32:fd-listen (fd-stream-fd fd-stream))) - #!-win32 - (setf (fd-stream-listen fd-stream) - (if (sysread-may-block-p fd-stream) - nil - ;; select(2) and CL:LISTEN have slightly different - ;; semantics. The former returns that an FD is - ;; readable when a read operation wouldn't block. - ;; That includes EOF. However, LISTEN must return - ;; NIL at EOF. - (progn (catch 'eof-input-catcher - ;; r-b/f too calls select, but it shouldn't - ;; block as long as read can return once w/o - ;; blocking - (refill-buffer/fd fd-stream)) - ;; If REFILL-BUFFER/FD set the FD-STREAM-LISTEN - ;; slot to a non-nil value (i.e. :EOF), keep - ;; that value. - (or (fd-stream-listen fd-stream) - ;; Otherwise we have data -> set the slot - ;; to T. - t)))))) + (labels ((do-listen () + (or (not (eql (fd-stream-ibuf-head fd-stream) + (fd-stream-ibuf-tail fd-stream))) + (fd-stream-listen fd-stream) + #!+win32 + (sb!win32:fd-listen (fd-stream-fd fd-stream)) + #!-win32 + ;; If the read can block, LISTEN will certainly return NIL. + (if (sysread-may-block-p fd-stream) + nil + ;; Otherwise select(2) and CL:LISTEN have slightly + ;; different semantics. The former returns that an FD + ;; is readable when a read operation wouldn't block. + ;; That includes EOF. However, LISTEN must return NIL + ;; at EOF. + (progn (catch 'eof-input-catcher + ;; r-b/f too calls select, but it shouldn't + ;; block as long as read can return once w/o + ;; blocking + (refill-buffer/fd fd-stream)) + ;; At this point either IBUF-HEAD != IBUF-TAIL + ;; and FD-STREAM-LISTEN is NIL, in which case + ;; we should return T, or IBUF-HEAD == + ;; IBUF-TAIL and FD-STREAM-LISTEN is :EOF, in + ;; which case we should return :EOF for this + ;; call and all future LISTEN call on this stream. + ;; Call ourselves again to determine which case + ;; applies. + (do-listen)))))) + (do-listen))) (:unread (setf (fd-stream-unread fd-stream) arg1) (setf (fd-stream-listen fd-stream) t)) @@ -2120,11 +2139,14 @@ (setf *available-buffers* nil) (with-output-to-string (*error-output*) (setf *stdin* - (make-fd-stream 0 :name "standard input" :input t :buffering :line)) + (make-fd-stream 0 :name "standard input" :input t :buffering :line + #!+win32 :external-format #!+win32 (sb!win32::console-input-codepage))) (setf *stdout* - (make-fd-stream 1 :name "standard output" :output t :buffering :line)) + (make-fd-stream 1 :name "standard output" :output t :buffering :line + #!+win32 :external-format #!+win32 (sb!win32::console-output-codepage))) (setf *stderr* - (make-fd-stream 2 :name "standard error" :output t :buffering :line)) + (make-fd-stream 2 :name "standard error" :output t :buffering :line + #!+win32 :external-format #!+win32 (sb!win32::console-output-codepage))) (let* ((ttyname #.(coerce "/dev/tty" 'simple-base-string)) (tty (sb!unix:unix-open ttyname sb!unix:o_rdwr #o666))) (if tty