X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=d98bf4a76f4a9bfe470acb8cc5c08d6d6482e025;hb=4d31006db24db375cdb83a5726d66c524b36689c;hp=5fde24522bf53bbc0262175089469fa4151bfbcb;hpb=fdbbe74c279db74e8855c58eaef02a30b2fa1917;p=sbcl.git

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 5fde245..d98bf4a 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -171,8 +171,9 @@
   (listen nil :type (member nil t :eof))
 
   ;; the input buffer
-  (unread nil)
+  (instead (make-array 0 :element-type 'character :adjustable t :fill-pointer t) :type (array character (*)))
   (ibuf nil :type (or buffer null))
+  (eof-forced-p nil :type (member t nil))
 
   ;; the output buffer
   (obuf nil :type (or buffer null))
@@ -187,7 +188,10 @@
   (external-format :default)
   ;; fixed width, or function to call with a character
   (char-size 1 :type (or fixnum function))
-  (output-bytes #'ill-out :type function))
+  (output-bytes #'ill-out :type function)
+  ;; a boolean indicating whether the stream is bivalent.  For
+  ;; internal use only.
+  (bivalent-p nil :type boolean))
 (def!method print-object ((fd-stream fd-stream) stream)
   (declare (type stream stream))
   (print-unreadable-object (fd-stream stream :type t :identity t)
@@ -418,12 +422,14 @@
 
 (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))
 
@@ -457,7 +463,24 @@
     (force-end-of-file ()
       :report (lambda (stream)
                 (format stream "~@<Force an end of file.~@:>"))
-      t)))
+      (setf (fd-stream-eof-forced-p stream) t))
+    (input-replacement (string)
+      :report (lambda (stream)
+                (format stream "~@<Use string as replacement input, ~
+                               attempt to resync at a character ~
+                               boundary and continue.~@:>"))
+      :interactive (lambda ()
+                     (format *query-io* "~@<Enter a string: ~@:>")
+                     (finish-output *query-io*)
+                     (list (read *query-io*)))
+      (let ((string (reverse (string string)))
+            (instead (fd-stream-instead stream)))
+        (dotimes (i (length string))
+          (vector-push-extend (char string i) instead))
+        (fd-stream-resync stream)
+        (when (> (length string) 0)
+          (setf (fd-stream-listen stream) t)))
+      nil)))
 
 (defun stream-encoding-error-and-handle (stream code)
   (restart-case
@@ -465,6 +488,16 @@
     (output-nothing ()
       :report (lambda (stream)
                 (format stream "~@<Skip output of this character.~@:>"))
+      (throw 'output-nothing nil))
+    (output-replacement (string)
+      :report (lambda (stream)
+                (format stream "~@<Output replacement string.~@:>"))
+      :interactive (lambda ()
+                     (format *query-io* "~@<Enter a string: ~@:>")
+                     (finish-output *query-io*)
+                     (list (read *query-io*)))
+      (let ((string (string string)))
+        (fd-sout stream (string string) 0 (length string)))
       (throw 'output-nothing nil))))
 
 (defun external-format-encoding-error (stream code)
@@ -472,11 +505,6 @@
       (stream-encoding-error-and-handle stream code)
       (c-string-encoding-error stream code)))
 
-(defun external-format-decoding-error (stream octet-count)
-  (if (streamp stream)
-      (stream-decoding-error stream octet-count)
-      (c-string-decoding-error stream octet-count)))
-
 (defun synchronize-stream-output (stream)
   ;; If we're reading and writing on the same file, flush buffered
   ;; input and rewind file position accordingly.
@@ -697,7 +725,7 @@
              (position #\newline thing :from-end t
                        :start start :end end))))
       (if (and (typep thing 'base-string)
-               (eq (fd-stream-external-format stream) :latin-1))
+               (eq (fd-stream-external-format-keyword stream) :latin-1))
           (ecase (fd-stream-buffering stream)
             (:full
              (buffer-output stream thing start end))
@@ -718,20 +746,109 @@
           (setf (fd-stream-char-pos stream) (- end last-newline 1))
           (incf (fd-stream-char-pos stream) (- end start))))))
 
-(defvar *external-formats* ()
+(defstruct (external-format
+             (:constructor %make-external-format)
+             (:conc-name ef-)
+             (:predicate external-format-p)
+             (:copier %copy-external-format))
+  ;; 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)
+  (write-char-none-buffered-fun (missing-arg) :type function)
+  (write-char-line-buffered-fun (missing-arg) :type function)
+  (write-char-full-buffered-fun (missing-arg) :type function)
+  ;; Can be nil for fixed-width formats.
+  (resync-fun nil :type (or function null))
+  (bytes-for-char-fun (missing-arg) :type function)
+  (read-c-string-fun (missing-arg) :type function)
+  (write-c-string-fun (missing-arg) :type function)
+  ;; We indirect through symbols in these functions so that a
+  ;; developer working on the octets code can easily redefine things
+  ;; and use the new function definition without redefining the
+  ;; external format as well.  The slots above don't do any
+  ;; indirection because a developer working with those slots would be
+  ;; redefining the external format anyway.
+  (octets-to-string-fun (missing-arg) :type function)
+  (string-to-octets-fun (missing-arg) :type function))
+
+(defun wrap-external-format-functions (external-format fun)
+  (let ((result (%copy-external-format external-format)))
+    (macrolet ((frob (accessor)
+                 `(setf (,accessor result) (funcall fun (,accessor result)))))
+      (frob ef-read-n-chars-fun)
+      (frob ef-read-char-fun)
+      (frob ef-write-n-bytes-fun)
+      (frob ef-write-char-none-buffered-fun)
+      (frob ef-write-char-line-buffered-fun)
+      (frob ef-write-char-full-buffered-fun)
+      (frob ef-resync-fun)
+      (frob ef-bytes-for-char-fun)
+      (frob ef-read-c-string-fun)
+      (frob ef-write-c-string-fun)
+      (frob ef-octets-to-string-fun)
+      (frob ef-string-to-octets-fun))
+    result))
+
+(defvar *external-formats* (make-hash-table)
   #!+sb-doc
-  "List of all available external formats. Each element is a list of the
-  element-type, string input function name, character input function name,
-  and string output function name.")
+  "Hashtable of all available external formats. The table maps from
+  external-format names to EXTERNAL-FORMAT structures.")
 
 (defun get-external-format (external-format)
-  (dolist (entry *external-formats*)
-    (when (member external-format (first entry))
-      (return entry))))
-
-(defun get-external-format-function (external-format index)
-  (let ((entry (get-external-format external-format)))
-    (when entry (nth index entry))))
+  (flet ((keyword-external-format (keyword)
+           (declare (type keyword keyword))
+           (gethash keyword *external-formats*))
+         (replacement-handlerify (entry replacement)
+           (when entry
+             (wrap-external-format-functions
+              entry
+              (lambda (fun)
+                (and fun
+                     (lambda (&rest rest)
+                       (declare (dynamic-extent rest))
+                       (handler-bind
+                           ((stream-decoding-error
+                             (lambda (c)
+                               (declare (ignore c))
+                               (invoke-restart 'input-replacement replacement)))
+                            (stream-encoding-error
+                             (lambda (c)
+                               (declare (ignore c))
+                               (invoke-restart 'output-replacement replacement)))
+                            (octets-encoding-error
+                             (lambda (c) (use-value replacement c)))
+                            (octet-decoding-error
+                             (lambda (c) (use-value replacement c))))
+                         (apply fun rest)))))))))
+    (typecase external-format
+      (keyword (keyword-external-format external-format))
+      ((cons keyword)
+       (let ((entry (keyword-external-format (car external-format)))
+             (replacement (getf (cdr external-format) :replacement)))
+         (if replacement
+             (replacement-handlerify entry replacement)
+             entry))))))
+
+(defun get-external-format-or-lose (external-format)
+  (or (get-external-format external-format)
+      (error "Undefined external-format ~A" external-format)))
+
+(defun external-format-keyword (external-format)
+  (typecase external-format
+    (keyword external-format)
+    ((cons keyword) (car external-format))))
+
+(defun fd-stream-external-format-keyword (stream)
+  (external-format-keyword (fd-stream-external-format stream)))
+
+(defun canonize-external-format (external-format entry)
+  (typecase external-format
+    (keyword (first (ef-names entry)))
+    ((cons keyword) (cons (first (ef-names entry)) (rest external-format)))))
 
 ;;; Find an output routine to use given the type and buffering. Return
 ;;; as multiple values the routine, the real type transfered, and the
@@ -741,15 +858,14 @@
     (let ((entry (get-external-format external-format)))
       (when entry
         (return-from pick-output-routine
-          (values (symbol-function (nth (ecase buffering
-                                          (:none 4)
-                                          (:line 5)
-                                          (:full 6))
-                                        entry))
+          (values (ecase buffering
+                    (:none (ef-write-char-none-buffered-fun entry))
+                    (:line (ef-write-char-line-buffered-fun entry))
+                    (:full (ef-write-char-full-buffered-fun entry)))
                   'character
                   1
-                  (symbol-function (fourth entry))
-                  (first (first entry)))))))
+                  (ef-write-n-bytes-fun entry)
+                  (canonize-external-format external-format entry))))))
   (dolist (entry *output-routines*)
     (when (and (subtypep type (first entry))
                (eq buffering (second entry))
@@ -951,45 +1067,57 @@
     `(let* ((,stream-var ,stream)
             (ibuf (fd-stream-ibuf ,stream-var))
             (size nil))
-       (if (fd-stream-unread ,stream-var)
-           (prog1
-               (fd-stream-unread ,stream-var)
-             (setf (fd-stream-unread ,stream-var) nil)
-             (setf (fd-stream-listen ,stream-var) nil))
-           (let ((,element-var nil)
-                 (decode-break-reason nil))
-             (do ((,retry-var t))
-                 ((not ,retry-var))
-               (unless
-                   (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))))
-                               (declare (ignorable byte))
-                               (setq size ,bytes)
-                               (input-at-least ,stream-var size)
-                               (setq ,element-var (locally ,@read-forms))
-                               (setq ,retry-var nil))
-                             nil))
-                     (when decode-break-reason
-                       (stream-decoding-error-and-handle stream
-                                                         decode-break-reason))
-                     t)
-                 (let ((octet-count (- (buffer-tail ibuf)
-                                       (buffer-head ibuf))))
-                   (when (or (zerop octet-count)
-                             (and (not ,element-var)
-                                  (not decode-break-reason)
-                                  (stream-decoding-error-and-handle
-                                   stream octet-count)))
-                     (setq ,retry-var nil)))))
-             (cond (,element-var
-                    (incf (buffer-head ibuf) size)
-                    ,element-var)
-                   (t
-                    (eof-or-lose ,stream-var ,eof-error ,eof-value))))))))
+       (block use-instead
+         (when (fd-stream-eof-forced-p ,stream-var)
+           (setf (fd-stream-eof-forced-p ,stream-var) nil)
+           (return-from use-instead
+             (eof-or-lose ,stream-var ,eof-error ,eof-value)))
+         (let ((,element-var nil)
+               (decode-break-reason nil))
+           (do ((,retry-var t))
+               ((not ,retry-var))
+             (if (> (length (fd-stream-instead ,stream-var)) 0)
+                 (let* ((instead (fd-stream-instead ,stream-var))
+                        (result (vector-pop instead))
+                        (pointer (fill-pointer instead)))
+                   (when (= pointer 0)
+                     (setf (fd-stream-listen ,stream-var) nil))
+                   (return-from use-instead result))
+                 (unless
+                     (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)))
+                               (let* ((byte (sap-ref-8 (buffer-sap ibuf) (buffer-head ibuf))))
+                                 (declare (ignorable byte))
+                                 ,@(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))
+                       (when decode-break-reason
+                         (when (stream-decoding-error-and-handle
+                                stream decode-break-reason)
+                           (setq ,retry-var nil)
+                           (throw 'eof-input-catcher nil)))
+                       t)
+                   (let ((octet-count (- (buffer-tail ibuf)
+                                         (buffer-head ibuf))))
+                     (when (or (zerop octet-count)
+                               (and (not ,element-var)
+                                    (not decode-break-reason)
+                                    (stream-decoding-error-and-handle
+                                     stream octet-count)))
+                       (setq ,retry-var nil))))))
+           (cond (,element-var
+                  (incf (buffer-head ibuf) size)
+                  ,element-var)
+                 (t
+                  (eof-or-lose ,stream-var ,eof-error ,eof-value))))))))
 
 ;;; a macro to wrap around all input routines to handle EOF-ERROR noise
 (defmacro input-wrapper ((stream bytes eof-error eof-value) &body read-forms)
@@ -997,11 +1125,8 @@
         (element-var (gensym "ELT")))
     `(let* ((,stream-var ,stream)
             (ibuf (fd-stream-ibuf ,stream-var)))
-       (if (fd-stream-unread ,stream-var)
-           (prog1
-               (fd-stream-unread ,stream-var)
-             (setf (fd-stream-unread ,stream-var) nil)
-             (setf (fd-stream-listen ,stream-var) nil))
+       (if (> (length (fd-stream-instead ,stream-var)) 0)
+           (bug "INSTEAD not empty in INPUT-WRAPPER for ~S" ,stream-var)
            (let ((,element-var
                   (catch 'eof-input-catcher
                     (input-at-least ,stream-var ,bytes)
@@ -1087,14 +1212,14 @@
 ;;; bytes per element (and for character types string input routine).
 (defun pick-input-routine (type &optional external-format)
   (when (subtypep type 'character)
-    (dolist (entry *external-formats*)
-      (when (member external-format (first entry))
+    (let ((entry (get-external-format external-format)))
+      (when entry
         (return-from pick-input-routine
-          (values (symbol-function (third entry))
+          (values (ef-read-char-fun entry)
                   'character
                   1
-                  (symbol-function (second entry))
-                  (first (first entry)))))))
+                  (ef-read-n-chars-fun entry)
+                  (canonize-external-format external-format entry))))))
   (dolist (entry *input-routines*)
     (when (and (subtypep type (first entry))
                (or (not (fourth entry))
@@ -1150,22 +1275,7 @@
                                &aux (total-copied 0))
   (declare (type fd-stream stream))
   (declare (type index start requested total-copied))
-  (let ((unread (fd-stream-unread stream)))
-    (when unread
-      ;; AVERs designed to fail when we have more complicated
-      ;; character representations.
-      (aver (typep unread 'base-char))
-      (aver (= (fd-stream-element-size stream) 1))
-      ;; KLUDGE: this is a slightly-unrolled-and-inlined version of
-      ;; %BYTE-BLT
-      (etypecase buffer
-        (system-area-pointer
-         (setf (sap-ref-8 buffer start) (char-code unread)))
-        ((simple-unboxed-array (*))
-         (setf (aref buffer start) unread)))
-      (setf (fd-stream-unread stream) nil)
-      (setf (fd-stream-listen stream) nil)
-      (incf total-copied)))
+  (aver (= (length (fd-stream-instead stream)) 0))
   (do ()
       (nil)
     (let* ((remaining-request (- requested total-copied))
@@ -1197,15 +1307,14 @@
             ))))
 
 (defun fd-stream-resync (stream)
-  (dolist (entry *external-formats*)
-    (when (member (fd-stream-external-format stream) (first entry))
-      (return-from fd-stream-resync
-        (funcall (symbol-function (eighth entry)) stream)))))
+  (let ((entry (get-external-format (fd-stream-external-format stream))))
+    (when entry
+      (funcall (ef-resync-fun entry) stream))))
 
 (defun get-fd-stream-character-sizer (stream)
-  (dolist (entry *external-formats*)
-    (when (member (fd-stream-external-format stream) (first entry))
-      (return-from get-fd-stream-character-sizer (ninth entry)))))
+  (let ((entry (get-external-format (fd-stream-external-format stream))))
+    (when entry
+      (ef-bytes-for-char-fun entry))))
 
 (defun fd-stream-character-size (stream char)
   (let ((sizer (get-fd-stream-character-sizer stream)))
@@ -1218,193 +1327,82 @@
 
 (defun find-external-format (external-format)
   (when external-format
-    (find external-format *external-formats* :test #'member :key #'car)))
+    (get-external-format external-format)))
 
 (defun variable-width-external-format-p (ef-entry)
-  (when (eighth ef-entry) t))
+  (and ef-entry (not (null (ef-resync-fun ef-entry)))))
 
 (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)
-  (let* ((name (first external-format))
-         (out-function (symbolicate "OUTPUT-BYTES/" name))
-         (format (format nil "OUTPUT-CHAR-~A-~~A-BUFFERED" (string name)))
-         (in-function (symbolicate "FD-STREAM-READ-N-CHARACTERS/" name))
-         (in-char-function (symbolicate "INPUT-CHAR/" name))
-         (size-function (symbolicate "BYTES-FOR-CHAR/" name))
-         (read-c-string-function (symbolicate "READ-FROM-C-STRING/" name))
-         (output-c-string-function (symbolicate "OUTPUT-TO-C-STRING/" name))
-         (n-buffer (gensym "BUFFER")))
+  (if ef-entry (ef-bytes-for-char-fun ef-entry) (constantly 1)))
+
+(defmacro define-unibyte-mapping-external-format
+    (canonical-name (&rest other-names) &body exceptions)
+  (let ((->code-name (symbolicate canonical-name '->code-mapper))
+        (code->-name (symbolicate 'code-> canonical-name '-mapper))
+        (get-bytes-name (symbolicate 'get- canonical-name '-bytes))
+        (string->-name (symbolicate 'string-> canonical-name))
+        (define-string*-name (symbolicate 'define- canonical-name '->string*))
+        (string*-name (symbolicate canonical-name '->string*))
+        (define-string-name (symbolicate 'define- canonical-name '->string))
+        (string-name (symbolicate canonical-name '->string))
+        (->string-aref-name (symbolicate canonical-name '->string-aref)))
     `(progn
-      (defun ,size-function (byte)
-        (declare (ignore byte))
-        ,size)
-      (defun ,out-function (stream string flush-p start end)
-        (let ((start (or start 0))
-              (end (or end (length string))))
-          (declare (type index start end))
-          (synchronize-stream-output stream)
-          (unless (<= 0 start end (length string))
-            (sequence-bounding-indices-bad-error string start end))
-          (do ()
-              ((= end start))
-            (let ((obuf (fd-stream-obuf stream)))
-              (setf (buffer-tail obuf)
-                    (string-dispatch (simple-base-string
-                                      #!+sb-unicode
-                                      (simple-array character (*))
-                                      string)
-                        string
-                      (let ((sap (buffer-sap obuf))
-                            (len (buffer-length obuf))
-                            ;; FIXME: rename
-                            (tail (buffer-tail obuf)))
-                       (declare (type index tail)
-                                ;; STRING bounds have already been checked.
-                                (optimize (safety 0)))
-                       (loop
-                         (,@(if output-restart
-                                `(catch 'output-nothing)
-                                `(progn))
-                            (do* ()
-                                 ((or (= start end) (< (- len tail) 4)))
-                              (let* ((byte (aref string start))
-                                     (bits (char-code byte)))
-                                ,out-expr
-                                (incf tail ,size)
-                                (incf start)))
-                            ;; Exited from the loop normally
-                            (return tail))
-                         ;; Exited via CATCH. Skip the current character
-                         ;; and try the inner loop again.
-                         (incf start))))))
-            (when (< start end)
-              (flush-output-buffer stream)))
-          (when flush-p
-            (flush-output-buffer stream))))
-      (def-output-routines (,format
-                            ,size
-                            ,output-restart
-                            (:none character)
-                            (:line character)
-                            (:full character))
-          (if (eql byte #\Newline)
-              (setf (fd-stream-char-pos stream) 0)
-              (incf (fd-stream-char-pos stream)))
-          (let* ((obuf (fd-stream-obuf stream))
-                 (bits (char-code byte))
-                 (sap (buffer-sap obuf))
-                 (tail (buffer-tail obuf)))
-            ,out-expr))
-      (defun ,in-function (stream buffer start requested eof-error-p
-                           &aux (index start) (end (+ start requested)))
-        (declare (type fd-stream stream)
-                 (type index start requested index end)
-                 (type
-                  (simple-array character (#.+ansi-stream-in-buffer-length+))
-                  buffer))
-        (let ((unread (fd-stream-unread stream)))
-          (when unread
-            (setf (aref buffer index) unread)
-            (setf (fd-stream-unread stream) nil)
-            (setf (fd-stream-listen stream) nil)
-            (incf index)))
-        (do ()
-            (nil)
-          (let* ((ibuf (fd-stream-ibuf stream))
-                 (head (buffer-head ibuf))
-                 (tail (buffer-tail ibuf))
-                 (sap (buffer-sap ibuf)))
-            (declare (type index head tail)
-                     (type system-area-pointer sap))
-            ;; Copy data from stream buffer into user's buffer.
-            (dotimes (i (min (truncate (- tail head) ,size)
-                             (- end index)))
-              (declare (optimize speed))
-              (let* ((byte (sap-ref-8 sap head)))
-                (setf (aref buffer index) ,in-expr)
-                (incf index)
-                (incf head ,size)))
-            (setf (buffer-head ibuf) head)
-            ;; Maybe we need to refill the stream buffer.
-            (cond ( ;; If there was enough data in the stream buffer, we're done.
-                   (= index end)
-                   (return (- index start)))
-                  ( ;; If EOF, we're done in another way.
-                   (null (catch 'eof-input-catcher (refill-input-buffer stream)))
-                   (if eof-error-p
-                       (error 'end-of-file :stream stream)
-                       (return (- index start))))
-                  ;; Otherwise we refilled the stream buffer, so fall
-                  ;; through into another pass of the loop.
-                  ))))
-      (def-input-routine ,in-char-function (character ,size sap head)
-        (let ((byte (sap-ref-8 sap head)))
-          ,in-expr))
-      (defun ,read-c-string-function (sap element-type)
-        (declare (type system-area-pointer sap)
-                 (type (member character base-char) element-type))
-        (locally
-            (declare (optimize (speed 3) (safety 0)))
-          (let* ((stream ,name)
-                 (length
-                  (loop for head of-type index upfrom 0 by ,size
-                        for count of-type index upto (1- array-dimension-limit)
-                        for byte = (sap-ref-8 sap head)
-                        for char of-type character = ,in-expr
-                        until (zerop (char-code char))
-                        finally (return count)))
-                 ;; Inline the common cases
-                 (string (make-string length :element-type element-type)))
-            (declare (ignorable stream)
-                     (type index length)
-                     (type simple-string string))
-            (/show0 before-copy-loop)
-            (loop for head of-type index upfrom 0 by ,size
-               for index of-type index below length
-               for byte = (sap-ref-8 sap head)
-               for char of-type character = ,in-expr
-               do (setf (aref string index) char))
-            string))) ;; last loop rewrite to dotimes?
-        (defun ,output-c-string-function (string)
-          (declare (type simple-string string))
-          (locally
-              (declare (optimize (speed 3) (safety 0)))
-            (let* ((length (length string))
-                   (,n-buffer (make-array (* (1+ length) ,size)
-                                          :element-type '(unsigned-byte 8)))
-                   (tail 0)
-                   (stream ,name))
-              (declare (type index length tail))
-              (with-pinned-objects (,n-buffer)
-                (let ((sap (vector-sap ,n-buffer)))
-                  (declare (system-area-pointer sap))
-                  (dotimes (i length)
-                    (let* ((byte (aref string i))
-                           (bits (char-code byte)))
-                      (declare (ignorable byte bits))
-                      ,out-expr)
-                    (incf tail ,size))
-                  (let* ((bits 0)
-                         (byte (code-char bits)))
-                    (declare (ignorable bits byte))
-                    ,out-expr)))
-              ,n-buffer)))
-      (setf *external-formats*
-       (cons '(,external-format ,in-function ,in-char-function ,out-function
-               ,@(mapcar #'(lambda (buffering)
-                             (intern (format nil format (string buffering))))
-                         '(:none :line :full))
-               nil ; no resync-function
-               ,size-function ,read-c-string-function ,output-c-string-function)
-        *external-formats*)))))
+       (define-unibyte-mapper ,->code-name ,code->-name
+         ,@exceptions)
+       (declaim (inline ,get-bytes-name))
+       (defun ,get-bytes-name (string pos)
+         (declare (optimize speed (safety 0))
+                  (type simple-string string)
+                  (type array-range pos))
+         (get-latin-bytes #',code->-name ,canonical-name string pos))
+       (defun ,string->-name (string sstart send null-padding)
+         (declare (optimize speed (safety 0))
+                  (type simple-string string)
+                  (type array-range sstart send))
+         (values (string->latin% string sstart send #',get-bytes-name null-padding)))
+       (defmacro ,define-string*-name (accessor type)
+         (declare (ignore type))
+         (let ((name (make-od-name ',string*-name accessor)))
+           `(progn
+              (defun ,name (string sstart send array astart aend)
+                (,(make-od-name 'latin->string* accessor)
+                  string sstart send array astart aend #',',->code-name)))))
+       (instantiate-octets-definition ,define-string*-name)
+       (defmacro ,define-string-name (accessor type)
+         (declare (ignore type))
+         (let ((name (make-od-name ',string-name accessor)))
+           `(progn
+              (defun ,name (array astart aend)
+                (,(make-od-name 'latin->string accessor)
+                  array astart aend #',',->code-name)))))
+       (instantiate-octets-definition ,define-string-name)
+       (define-unibyte-external-format ,canonical-name ,other-names
+         (let ((octet (,code->-name bits)))
+           (if octet
+               (setf (sap-ref-8 sap tail) octet)
+               (external-format-encoding-error stream bits)))
+         (let ((code (,->code-name byte)))
+           (if code
+               (code-char code)
+               (return-from decode-break-reason 1)))
+         ,->string-aref-name
+         ,string->-name))))
+
+(defmacro define-unibyte-external-format
+    (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
+     ,out-form
+     1
+     ,in-form
+     ,octets-to-string-symbol
+     ,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))
          (format (format nil "OUTPUT-CHAR-~A-~~A-BUFFERED" (string name)))
@@ -1425,40 +1423,37 @@
           (declare (type index start end))
           (synchronize-stream-output stream)
           (unless (<= 0 start end (length string))
-            (sequence-bounding-indices-bad string start end))
+            (sequence-bounding-indices-bad-error string start end))
           (do ()
               ((= end start))
             (let ((obuf (fd-stream-obuf stream)))
-              (setf (buffer-tail obuf)
-                    (string-dispatch (simple-base-string
-                                      #!+sb-unicode
-                                      (simple-array character (*))
-                                      string)
-                        string
-                      (let ((len (buffer-length obuf))
-                            (sap (buffer-sap obuf))
-                            ;; FIXME: Rename
-                            (tail (buffer-tail obuf)))
-                        (declare (type index tail)
-                                 ;; STRING bounds have already been checked.
-                                 (optimize (safety 0)))
-                        (loop
-                          (,@(if output-restart
-                                 `(catch 'output-nothing)
-                                 `(progn))
-                             (do* ()
-                                  ((or (= start end) (< (- len tail) 4)))
-                               (let* ((byte (aref string start))
-                                      (bits (char-code byte))
-                                      (size ,out-size-expr))
-                                 ,out-expr
-                                 (incf tail size)
-                                 (incf start)))
-                             ;; Exited from the loop normally
-                             (return tail))
-                          ;; Exited via CATCH. Skip the current character
-                          ;; and try the inner loop again.
-                          (incf start))))))
+              (string-dispatch (simple-base-string
+                                #!+sb-unicode (simple-array character (*))
+                                string)
+                  string
+                (let ((len (buffer-length obuf))
+                      (sap (buffer-sap obuf))
+                      ;; FIXME: Rename
+                      (tail (buffer-tail obuf)))
+                  (declare (type index tail)
+                           ;; STRING bounds have already been checked.
+                           (optimize (safety 0)))
+                  (,@(if output-restart
+                         `(catch 'output-nothing)
+                         `(progn))
+                     (do* ()
+                          ((or (= start end) (< (- len tail) 4)))
+                       (let* ((byte (aref string start))
+                              (bits (char-code byte))
+                              (size ,out-size-expr))
+                         ,out-expr
+                         (incf tail size)
+                         (setf (buffer-tail obuf) tail)
+                         (incf start)))
+                     (go flush))
+                  ;; Exited via CATCH: skip the current character.
+                  (incf start))))
+           flush
             (when (< start end)
               (flush-output-buffer stream)))
           (when flush-p
@@ -1484,12 +1479,18 @@
                  (type
                   (simple-array character (#.+ansi-stream-in-buffer-length+))
                   buffer))
-        (let ((unread (fd-stream-unread stream)))
-          (when unread
-            (setf (aref buffer start) unread)
-            (setf (fd-stream-unread stream) nil)
-            (setf (fd-stream-listen stream) nil)
-            (incf total-copied)))
+        (when (fd-stream-eof-forced-p stream)
+          (setf (fd-stream-eof-forced-p stream) nil)
+          (return-from ,in-function 0))
+        (do ((instead (fd-stream-instead stream)))
+            ((= (fill-pointer instead) 0)
+             (setf (fd-stream-listen stream) nil))
+          (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)
           (let* ((ibuf (fd-stream-ibuf stream))
@@ -1503,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)
@@ -1527,8 +1531,10 @@
                   (if eof-error-p
                       (error 'end-of-file :stream stream)
                       (return-from ,in-function total-copied)))
-                (setf head (buffer-head ibuf))
-                (setf tail (buffer-tail ibuf))))
+                ;; we might have been given stuff to use instead, so
+                ;; we have to return (and trust our caller to know
+                ;; what to do about TOTAL-COPIED being 0).
+                (return-from ,in-function total-copied)))
             (setf (buffer-head ibuf) head)
             ;; Maybe we need to refill the stream buffer.
             (cond ( ;; If there were enough data in the stream buffer, we're done.
@@ -1552,21 +1558,24 @@
           (declare (ignorable byte))
           ,in-expr))
       (defun ,resync-function (stream)
-        (let ((ibuf (fd-stream-ibuf stream)))
-          (loop
-            (input-at-least stream 2)
-            (incf (buffer-head ibuf))
-            (unless (block decode-break-reason
-                      (let* ((sap (buffer-sap ibuf))
-                             (head (buffer-head ibuf))
-                             (byte (sap-ref-8 sap head))
-                             (size ,in-size-expr))
-                        (declare (ignorable byte))
-                        (input-at-least stream size)
-                        (setf head (buffer-head ibuf))
-                        ,in-expr)
-                     nil)
-             (return)))))
+        (let ((ibuf (fd-stream-ibuf stream))
+              size)
+          (catch 'eof-input-catcher
+            (loop
+               (incf (buffer-head ibuf))
+               (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)))
+                           (declare (ignorable byte))
+                           ,@(when (consp in-size-expr)
+                               `((setq size ,(cadr in-size-expr))
+                                 (input-at-least stream size)))
+                           (setf head (buffer-head ibuf))
+                           ,in-expr)
+                         nil)
+                 (return))))))
       (defun ,read-c-string-function (sap element-type)
         (declare (type system-area-pointer sap))
         (locally
@@ -1578,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))
@@ -1597,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,141 +1655,28 @@
                   ,out-expr)))
             ,n-buffer)))
 
-      (setf *external-formats*
-       (cons '(,external-format ,in-function ,in-char-function ,out-function
-               ,@(mapcar #'(lambda (buffering)
-                             (intern (format nil format (string buffering))))
-                         '(:none :line :full))
-               ,resync-function
-               ,size-function ,read-c-string-function ,output-c-string-function)
-        *external-formats*)))))
-
-;;; Multiple names for the :ISO{,-}8859-* families are needed because on
-;;; FreeBSD (and maybe other BSD systems), nl_langinfo("LATIN-1") will
-;;; return "ISO8859-1" instead of "ISO-8859-1".
-(define-external-format (:latin-1 :latin1 :iso-8859-1 :iso8859-1)
-    1 t
-  (if (>= bits 256)
-      (external-format-encoding-error stream bits)
-      (setf (sap-ref-8 sap tail) bits))
-  (code-char byte))
-
-(define-external-format (:ascii :us-ascii :ansi_x3.4-1968
-                         :iso-646 :iso-646-us :|646|)
-    1 t
-  (if (>= bits 128)
-      (external-format-encoding-error stream bits)
-      (setf (sap-ref-8 sap tail) bits))
-  (code-char byte))
-
-(let* ((table (let ((s (make-string 256)))
-                (map-into s #'code-char
-                          '(#x00 #x01 #x02 #x03 #x9c #x09 #x86 #x7f #x97 #x8d #x8e #x0b #x0c #x0d #x0e #x0f
-                            #x10 #x11 #x12 #x13 #x9d #x85 #x08 #x87 #x18 #x19 #x92 #x8f #x1c #x1d #x1e #x1f
-                            #x80 #x81 #x82 #x83 #x84 #x0a #x17 #x1b #x88 #x89 #x8a #x8b #x8c #x05 #x06 #x07
-                            #x90 #x91 #x16 #x93 #x94 #x95 #x96 #x04 #x98 #x99 #x9a #x9b #x14 #x15 #x9e #x1a
-                            #x20 #xa0 #xe2 #xe4 #xe0 #xe1 #xe3 #xe5 #xe7 #xf1 #xa2 #x2e #x3c #x28 #x2b #x7c
-                            #x26 #xe9 #xea #xeb #xe8 #xed #xee #xef #xec #xdf #x21 #x24 #x2a #x29 #x3b #xac
-                            #x2d #x2f #xc2 #xc4 #xc0 #xc1 #xc3 #xc5 #xc7 #xd1 #xa6 #x2c #x25 #x5f #x3e #x3f
-                            #xf8 #xc9 #xca #xcb #xc8 #xcd #xce #xcf #xcc #x60 #x3a #x23 #x40 #x27 #x3d #x22
-                            #xd8 #x61 #x62 #x63 #x64 #x65 #x66 #x67 #x68 #x69 #xab #xbb #xf0 #xfd #xfe #xb1
-                            #xb0 #x6a #x6b #x6c #x6d #x6e #x6f #x70 #x71 #x72 #xaa #xba #xe6 #xb8 #xc6 #xa4
-                            #xb5 #x7e #x73 #x74 #x75 #x76 #x77 #x78 #x79 #x7a #xa1 #xbf #xd0 #xdd #xde #xae
-                            #x5e #xa3 #xa5 #xb7 #xa9 #xa7 #xb6 #xbc #xbd #xbe #x5b #x5d #xaf #xa8 #xb4 #xd7
-                            #x7b #x41 #x42 #x43 #x44 #x45 #x46 #x47 #x48 #x49 #xad #xf4 #xf6 #xf2 #xf3 #xf5
-                            #x7d #x4a #x4b #x4c #x4d #x4e #x4f #x50 #x51 #x52 #xb9 #xfb #xfc #xf9 #xfa #xff
-                            #x5c #xf7 #x53 #x54 #x55 #x56 #x57 #x58 #x59 #x5a #xb2 #xd4 #xd6 #xd2 #xd3 #xd5
-                            #x30 #x31 #x32 #x33 #x34 #x35 #x36 #x37 #x38 #x39 #xb3 #xdb #xdc #xd9 #xda #x9f))
-                s))
-       (reverse-table (let ((rt (make-array 256 :element-type '(unsigned-byte 8) :initial-element 0)))
-                          (loop for char across table for i from 0
-                               do (aver (= 0 (aref rt (char-code char))))
-                               do (setf (aref rt (char-code char)) i))
-                          rt)))
-  (define-external-format (:ebcdic-us :ibm-037 :ibm037)
-      1 t
-    (if (>= bits 256)
-        (external-format-encoding-error stream bits)
-        (setf (sap-ref-8 sap tail) (aref reverse-table bits)))
-    (aref table byte)))
-
-
-#!+sb-unicode
-(let ((latin-9-table (let ((table (make-string 256)))
-                       (do ((i 0 (1+ i)))
-                           ((= i 256))
-                         (setf (aref table i) (code-char i)))
-                       (setf (aref table #xa4) (code-char #x20ac))
-                       (setf (aref table #xa6) (code-char #x0160))
-                       (setf (aref table #xa8) (code-char #x0161))
-                       (setf (aref table #xb4) (code-char #x017d))
-                       (setf (aref table #xb8) (code-char #x017e))
-                       (setf (aref table #xbc) (code-char #x0152))
-                       (setf (aref table #xbd) (code-char #x0153))
-                       (setf (aref table #xbe) (code-char #x0178))
-                       table))
-      (latin-9-reverse-1 (make-array 16
-                                     :element-type '(unsigned-byte 21)
-                                     :initial-contents '(#x0160 #x0161 #x0152 #x0153 0 0 0 0 #x0178 0 0 0 #x20ac #x017d #x017e 0)))
-      (latin-9-reverse-2 (make-array 16
-                                     :element-type '(unsigned-byte 8)
-                                     :initial-contents '(#xa6 #xa8 #xbc #xbd 0 0 0 0 #xbe 0 0 0 #xa4 #xb4 #xb8 0))))
-  (define-external-format (:latin-9 :latin9 :iso-8859-15 :iso8859-15)
-      1 t
-    (setf (sap-ref-8 sap tail)
-          (if (< bits 256)
-              (if (= bits (char-code (aref latin-9-table bits)))
-                  bits
-                  (external-format-encoding-error stream byte))
-              (if (= (aref latin-9-reverse-1 (logand bits 15)) bits)
-                  (aref latin-9-reverse-2 (logand bits 15))
-                  (external-format-encoding-error stream byte))))
-    (aref latin-9-table byte)))
-
-(define-external-format/variable-width (:utf-8 :utf8) nil
-  (let ((bits (char-code byte)))
-    (cond ((< bits #x80) 1)
-          ((< bits #x800) 2)
-          ((< bits #x10000) 3)
-          (t 4)))
-  (ecase size
-    (1 (setf (sap-ref-8 sap tail) bits))
-    (2 (setf (sap-ref-8 sap tail)       (logior #xc0 (ldb (byte 5 6) bits))
-             (sap-ref-8 sap (+ 1 tail)) (logior #x80 (ldb (byte 6 0) bits))))
-    (3 (setf (sap-ref-8 sap tail)       (logior #xe0 (ldb (byte 4 12) bits))
-             (sap-ref-8 sap (+ 1 tail)) (logior #x80 (ldb (byte 6 6) bits))
-             (sap-ref-8 sap (+ 2 tail)) (logior #x80 (ldb (byte 6 0) bits))))
-    (4 (setf (sap-ref-8 sap tail)       (logior #xf0 (ldb (byte 3 18) bits))
-             (sap-ref-8 sap (+ 1 tail)) (logior #x80 (ldb (byte 6 12) bits))
-             (sap-ref-8 sap (+ 2 tail)) (logior #x80 (ldb (byte 6 6) bits))
-             (sap-ref-8 sap (+ 3 tail)) (logior #x80 (ldb (byte 6 0) bits)))))
-  (cond ((< byte #x80) 1)
-        ((< byte #xc2) (return-from decode-break-reason 1))
-        ((< byte #xe0) 2)
-        ((< byte #xf0) 3)
-        (t 4))
-  (code-char (ecase size
-               (1 byte)
-               (2 (let ((byte2 (sap-ref-8 sap (1+ head))))
-                    (unless (<= #x80 byte2 #xbf)
-                      (return-from decode-break-reason 2))
-                    (dpb byte (byte 5 6) byte2)))
-               (3 (let ((byte2 (sap-ref-8 sap (1+ head)))
-                        (byte3 (sap-ref-8 sap (+ 2 head))))
-                    (unless (and (<= #x80 byte2 #xbf)
-                                 (<= #x80 byte3 #xbf))
-                      (return-from decode-break-reason 3))
-                    (dpb byte (byte 4 12) (dpb byte2 (byte 6 6) byte3))))
-               (4 (let ((byte2 (sap-ref-8 sap (1+ head)))
-                        (byte3 (sap-ref-8 sap (+ 2 head)))
-                        (byte4 (sap-ref-8 sap (+ 3 head))))
-                    (unless (and (<= #x80 byte2 #xbf)
-                                 (<= #x80 byte3 #xbf)
-                                 (<= #x80 byte4 #xbf))
-                      (return-from decode-break-reason 4))
-                    (dpb byte (byte 3 18)
-                         (dpb byte2 (byte 6 12)
-                              (dpb byte3 (byte 6 6) byte4))))))))
+      (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
+                    ,@(mapcan #'(lambda (buffering)
+                                  (list (intern (format nil "WRITE-CHAR-~A-BUFFERED-FUN" buffering) :keyword)
+                                        `#',(intern (format nil format (string buffering)))))
+                              '(:none :line :full))
+                    :resync-fun #',resync-function
+                    :bytes-for-char-fun #',size-function
+                    :read-c-string-fun #',read-c-string-function
+                    :write-c-string-fun #',output-c-string-function
+                    :octets-to-string-fun (lambda (&rest rest)
+                                            (declare (dynamic-extent rest))
+                                            (apply ',octets-to-string-sym rest))
+                    :string-to-octets-fun (lambda (&rest rest)
+                                            (declare (dynamic-extent rest))
+                                            (apply ',string-to-octets-sym rest)))))
+        (dolist (ef ',external-format)
+          (setf (gethash ef *external-formats*) entry))))))
 
 ;;;; utility functions (misc routines, etc)
 
@@ -1896,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)
@@ -1975,13 +1874,12 @@
   ;; we're still safe: buffers have finalizers of their own.
   (release-fd-stream-buffers fd-stream))
 
-;;; Flushes the current input buffer and unread chatacter, and returns
-;;; the input buffer, and the amount of of flushed input in bytes.
+;;; Flushes the current input buffer and any supplied replacements,
+;;; and returns the input buffer, and the amount of of flushed input
+;;; in bytes.
 (defun flush-input-buffer (stream)
-  (let ((unread (if (fd-stream-unread stream)
-                    1
-                    0)))
-    (setf (fd-stream-unread stream) nil)
+  (let ((unread (length (fd-stream-instead stream))))
+    (setf (fill-pointer (fd-stream-instead stream)) 0)
     (let ((ibuf (fd-stream-ibuf stream)))
       (if ibuf
           (let ((head (buffer-head ibuf))
@@ -2039,8 +1937,8 @@
                                  (do-listen)))))))
        (do-listen)))
     (:unread
-     (setf (fd-stream-unread fd-stream) arg1)
-     (setf (fd-stream-listen fd-stream) t))
+     (decf (buffer-head (fd-stream-ibuf fd-stream))
+           (fd-stream-character-size fd-stream arg1)))
     (:close
      ;; Drop input buffers
      (setf (ansi-stream-in-index fd-stream) +ansi-stream-in-buffer-length+
@@ -2206,8 +2104,6 @@
         (let ((ibuf (fd-stream-ibuf stream)))
           (when ibuf
             (decf posn (- (buffer-tail ibuf) (buffer-head ibuf)))))
-        (when (fd-stream-unread stream)
-          (decf posn))
         ;; Divide bytes by element size.
         (truncate posn (fd-stream-element-size stream))))))
 
@@ -2313,6 +2209,7 @@
                                  :buffering buffering
                                  :dual-channel-p dual-channel-p
                                  :external-format external-format
+                                 :bivalent-p (eq element-type :default)
                                  :char-size (external-format-char-size external-format)
                                  :timeout
                                  (if timeout
@@ -2390,13 +2287,17 @@
         (:io     (values   t   t sb!unix:o_rdwr))
         (:probe  (values   t nil sb!unix:o_rdonly)))
     (declare (type index mask))
-    (let* ((pathname (merge-pathnames filename))
-           (namestring
-            (cond ((unix-namestring pathname input))
-                  ((and input (eq if-does-not-exist :create))
-                   (unix-namestring pathname nil))
-                  ((and (eq direction :io) (not if-does-not-exist-given))
-                   (unix-namestring pathname nil)))))
+    (let* (;; PATHNAME is the pathname we associate with the stream.
+           (pathname (merge-pathnames filename))
+           (physical (physicalize-pathname pathname))
+           (truename (probe-file physical))
+           ;; NAMESTRING is the native namestring we open the file with.
+           (namestring (cond (truename
+                              (native-namestring truename :as-file t))
+                             ((or (not input)
+                                  (and input (eq if-does-not-exist :create))
+                                  (and (eq direction :io) (not if-does-not-exist-given)))
+                              (native-namestring physical :as-file t)))))
       ;; Process if-exists argument if we are doing any output.
       (cond (output
              (unless if-exists-given
@@ -2461,7 +2362,7 @@
                           (when (and output (= (logand orig-mode #o170000)
                                                #o40000))
                             (error 'simple-file-error
-                                   :pathname namestring
+                                   :pathname pathname
                                    :format-control
                                    "can't open ~S for output: is a directory"
                                    :format-arguments (list namestring)))
@@ -2568,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
@@ -2577,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*))
@@ -2614,7 +2524,8 @@
       (cond (new-name
              (setf (fd-stream-pathname stream) new-name)
              (setf (fd-stream-file stream)
-                   (unix-namestring new-name nil))
+                   (native-namestring (physicalize-pathname new-name)
+                                      :as-file t))
              t)
             (t
              (fd-stream-pathname stream)))))