X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=d98bf4a76f4a9bfe470acb8cc5c08d6d6482e025;hb=4d31006db24db375cdb83a5726d66c524b36689c;hp=0761456567bffac01283504ab892e598b326508a;hpb=a18894dbea4495b885e1747babf4e2593dfb705e;p=sbcl.git diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 0761456..d98bf4a 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -754,6 +754,7 @@ ;; All the names that can refer to this external format. The first ;; one is the canonical name. (names (missing-arg) :type list :read-only t) + (default-replacement-character (missing-arg) :type character) (read-n-chars-fun (missing-arg) :type function) (read-char-fun (missing-arg) :type function) (write-n-bytes-fun (missing-arg) :type function) @@ -1086,12 +1087,15 @@ (catch 'eof-input-catcher (setf decode-break-reason (block decode-break-reason - (input-at-least ,stream-var 1) - (let* ((byte (sap-ref-8 (buffer-sap ibuf) - (buffer-head ibuf)))) + (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)) - (setq size ,bytes) - (input-at-least ,stream-var size) + ,@(when (consp bytes) + `((let ((sap (buffer-sap ibuf)) + (head (buffer-head ibuf))) + (declare (ignorable sap head)) + (setq size ,(cadr bytes)) + (input-at-least ,stream-var size)))) (setq ,element-var (locally ,@read-forms)) (setq ,retry-var nil)) nil)) @@ -1388,7 +1392,7 @@ (canonical-name (&rest other-names) out-form in-form octets-to-string-symbol string-to-octets-symbol) `(define-external-format/variable-width (,canonical-name ,@other-names) - t 1 + t #\? 1 ,out-form 1 ,in-form @@ -1396,8 +1400,8 @@ ,string-to-octets-symbol)) (defmacro define-external-format/variable-width - (external-format output-restart out-size-expr - out-expr in-size-expr in-expr + (external-format output-restart replacement-character + out-size-expr out-expr in-size-expr in-expr octets-to-string-sym string-to-octets-sym) (let* ((name (first external-format)) (out-function (symbolicate "OUTPUT-BYTES/" name)) @@ -1484,6 +1488,8 @@ (setf (aref buffer (+ start total-copied)) (vector-pop instead)) (incf total-copied) (when (= requested total-copied) + (when (= (fill-pointer instead) 0) + (setf (fd-stream-listen stream) nil)) (return-from ,in-function total-copied))) (do () (nil) @@ -1498,9 +1504,12 @@ ((or (= tail head) (= requested total-copied))) (setf decode-break-reason (block decode-break-reason + ,@(when (consp in-size-expr) + `((when (> ,(car in-size-expr) (- tail head)) + (return)))) (let ((byte (sap-ref-8 sap head))) (declare (ignorable byte)) - (setq size ,in-size-expr) + (setq size ,(if (consp in-size-expr) (cadr in-size-expr) in-size-expr)) (when (> size (- tail head)) (return)) (setf (aref buffer (+ start total-copied)) ,in-expr) @@ -1549,18 +1558,20 @@ (declare (ignorable byte)) ,in-expr)) (defun ,resync-function (stream) - (let ((ibuf (fd-stream-ibuf stream))) + (let ((ibuf (fd-stream-ibuf stream)) + size) (catch 'eof-input-catcher (loop (incf (buffer-head ibuf)) - (input-at-least stream 1) + (input-at-least stream ,(if (consp in-size-expr) (car in-size-expr) `(setq size ,in-size-expr))) (unless (block decode-break-reason (let* ((sap (buffer-sap ibuf)) (head (buffer-head ibuf)) - (byte (sap-ref-8 sap head)) - (size ,in-size-expr)) + (byte (sap-ref-8 sap head))) (declare (ignorable byte)) - (input-at-least stream size) + ,@(when (consp in-size-expr) + `((setq size ,(cadr in-size-expr)) + (input-at-least stream size))) (setf head (buffer-head ibuf)) ,in-expr) nil) @@ -1576,7 +1587,7 @@ (setf decode-break-reason (block decode-break-reason (setf byte (sap-ref-8 sap head) - size ,in-size-expr + size ,(if (consp in-size-expr) (cadr in-size-expr) in-size-expr) char ,in-expr) (incf head size) nil)) @@ -1595,7 +1606,7 @@ (setf decode-break-reason (block decode-break-reason (setf byte (sap-ref-8 sap head) - size ,in-size-expr + size ,(if (consp in-size-expr) (cadr in-size-expr) in-size-expr) char ,in-expr) (incf head size) nil)) @@ -1646,6 +1657,7 @@ (let ((entry (%make-external-format :names ',external-format + :default-replacement-character ,replacement-character :read-n-chars-fun #',in-function :read-char-fun #',in-char-function :write-n-bytes-fun #',out-function @@ -1780,11 +1792,14 @@ (when (or (not character-stream-p) bivalent-stream-p) (multiple-value-setq (bout-routine bout-type bout-size output-bytes normalized-external-format) - (pick-output-routine (if bivalent-stream-p - '(unsigned-byte 8) - target-type) - (fd-stream-buffering fd-stream) - external-format)) + (let ((buffering (fd-stream-buffering fd-stream))) + (if bivalent-stream-p + (pick-output-routine '(unsigned-byte 8) + (if (eq :line buffering) + :full + buffering) + external-format) + (pick-output-routine target-type buffering external-format)))) (unless bout-routine (error "could not find any output routine for ~S buffered ~S" (fd-stream-buffering fd-stream) @@ -1923,8 +1938,7 @@ (do-listen))) (:unread (decf (buffer-head (fd-stream-ibuf fd-stream)) - (fd-stream-character-size fd-stream arg1)) - (setf (fd-stream-listen fd-stream) t)) + (fd-stream-character-size fd-stream arg1))) (:close ;; Drop input buffers (setf (ansi-stream-in-index fd-stream) +ansi-stream-in-buffer-length+ @@ -2455,6 +2469,14 @@ (without-package-locks (makunbound '*available-buffers*)))) +(defun stdstream-external-format (outputp) + (declare (ignorable outputp)) + (let* ((keyword #!+win32 (if outputp (sb!win32::console-output-codepage) (sb!win32::console-input-codepage)) + #!-win32 (default-external-format)) + (ef (get-external-format keyword)) + (replacement (ef-default-replacement-character ef))) + `(,keyword :replacement ,replacement))) + ;;; This is called whenever a saved core is restarted. (defun stream-reinit (&optional init-buffers-p) (when init-buffers-p @@ -2464,22 +2486,23 @@ (with-output-to-string (*error-output*) (setf *stdin* (make-fd-stream 0 :name "standard input" :input t :buffering :line - #!+win32 :external-format #!+win32 (sb!win32::console-input-codepage))) + :element-type :default + :external-format (stdstream-external-format nil))) (setf *stdout* (make-fd-stream 1 :name "standard output" :output t :buffering :line - #!+win32 :external-format #!+win32 (sb!win32::console-output-codepage))) + :element-type :default + :external-format (stdstream-external-format t))) (setf *stderr* (make-fd-stream 2 :name "standard error" :output t :buffering :line - #!+win32 :external-format #!+win32 (sb!win32::console-output-codepage))) + :element-type :default + :external-format (stdstream-external-format t))) (let* ((ttyname #.(coerce "/dev/tty" 'simple-base-string)) (tty (sb!unix:unix-open ttyname sb!unix:o_rdwr #o666))) (if tty (setf *tty* - (make-fd-stream tty - :name "the terminal" - :input t - :output t - :buffering :line + (make-fd-stream tty :name "the terminal" + :input t :output t :buffering :line + :external-format (stdstream-external-format t) :auto-close t)) (setf *tty* (make-two-way-stream *stdin* *stdout*)))) (princ (get-output-stream-string *error-output*) *stderr*))