(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*
,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))
(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)
(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))
(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))
,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)
(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)))
(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))
(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