0.9.0.38:

[sbcl.git] / src / code / fd-stream.lisp

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index a6fdf1a..5c17dd1 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -31,16 +31,10 @@
       (pop *available-buffers*)
       (allocate-system-memory bytes-per-buffer)))
 \f
       (pop *available-buffers*)
       (allocate-system-memory bytes-per-buffer)))
 \f

-;;;; the FILE-STREAM structure
+;;;; the FD-STREAM structure

 
 

-(defstruct (file-stream
+(defstruct (fd-stream

            (:constructor %make-fd-stream)
            (:constructor %make-fd-stream)

-           ;; KLUDGE: in an ideal world, maybe we'd rewrite
-           ;; everything to use FILE-STREAM rather than simply
-           ;; providing this hack for compatibility with the old
-           ;; code.  However, CVS doesn't deal terribly well with
-           ;; file renaming, so for now we use this
-           ;; backward-compatibility feature.

            (:conc-name fd-stream-)
            (:predicate fd-stream-p)
            (:include ansi-stream
            (:conc-name fd-stream-)
            (:predicate fd-stream-p)
            (:include ansi-stream

@@ -63,6 +57,11 @@
   (fd -1 :type fixnum)       
   ;; controls when the output buffer is flushed
   (buffering :full :type (member :full :line :none))
   (fd -1 :type fixnum)       
   ;; controls when the output buffer is flushed
   (buffering :full :type (member :full :line :none))

+  ;; controls whether the input buffer must be cleared before output
+  ;; (must be done for files, not for sockets, pipes and other data
+  ;; sources where input and output aren't related).  non-NIL means
+  ;; don't clear input buffer.
+  (dual-channel-p nil)

   ;; character position (if known)
   (char-pos nil :type (or index null))
   ;; T if input is waiting on FD. :EOF if we hit EOF.
   ;; character position (if known)
   (char-pos nil :type (or index null))
   ;; T if input is waiting on FD. :EOF if we hit EOF.

@@ -89,7 +88,7 @@
   (pathname nil :type (or pathname null))
   (external-format :default)
   (output-bytes #'ill-out :type function))
   (pathname nil :type (or pathname null))
   (external-format :default)
   (output-bytes #'ill-out :type function))

-(def!method print-object ((fd-stream file-stream) stream)
+(def!method print-object ((fd-stream fd-stream) stream)

   (declare (type stream stream))
   (print-unreadable-object (fd-stream stream :type t :identity t)
     (format stream "for ~S" (fd-stream-name fd-stream))))
   (declare (type stream stream))
   (print-unreadable-object (fd-stream stream :type t :identity t)
     (format stream "for ~S" (fd-stream-name fd-stream))))

@@ -115,6 +114,46 @@
         :format-arguments
         (list note-format (list pathname) (strerror errno))))
 
         :format-arguments
         (list note-format (list pathname) (strerror errno))))
 

+(defun stream-decoding-error (stream octets)
+  (error 'stream-decoding-error
+        :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
+        :stream stream
+         :code code))
+
+;;; 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 ((sap (fd-stream-ibuf-sap stream))
+                                  (head (fd-stream-ibuf-head stream)))
+                              (loop for i from 0 below octet-count
+                                    collect (sap-ref-8 sap (+ head i)))))
+    (attempt-resync ()
+      :report (lambda (stream)
+               (format stream
+                       "~@<Attempt to resync the stream at a character ~
+                        character boundary and continue.~@:>"))
+      (fd-stream-resync stream)
+      nil)
+    (force-end-of-file ()
+      :report (lambda (stream)
+               (format stream "~@<Force an end of file.~@:>"))
+      t)))
+
+(defun stream-encoding-error-and-handle (stream code)
+  (restart-case
+      (stream-encoding-error stream code)
+    (output-nothing ()
+      :report (lambda (stream)
+               (format stream "~@<Skip output of this character.~@:>"))
+      (throw 'output-nothing nil))))
+

 ;;; This is called by the server when we can write to the given file
 ;;; descriptor. Attempt to write the data again. If it worked, remove
 ;;; the data from the OUTPUT-LATER list. If it didn't work, something
 ;;; This is called by the server when we can write to the given file
 ;;; descriptor. Attempt to write the data again. If it worked, remove
 ;;; the data from the OUTPUT-LATER list. If it didn't work, something

@@ -171,7 +210,7 @@
 ;;; writes. If so, just queue this one. Otherwise, try to write it. If
 ;;; this would block, queue it.
 (defun frob-output (stream base start end reuse-sap)
 ;;; writes. If so, just queue this one. Otherwise, try to write it. If
 ;;; this would block, queue it.
 (defun frob-output (stream base start end reuse-sap)

-  (declare (type file-stream stream)
+  (declare (type fd-stream stream)

           (type (or system-area-pointer (simple-array * (*))) base)
           (type index start end))
   (if (not (null (fd-stream-output-later stream))) ; something buffered.
           (type (or system-area-pointer (simple-array * (*))) base)
           (type index start end))
   (if (not (null (fd-stream-output-later stream))) ; something buffered.

@@ -199,7 +238,7 @@
       (frob-output stream (fd-stream-obuf-sap stream) 0 length t)
       (setf (fd-stream-obuf-tail stream) 0))))
 
       (frob-output stream (fd-stream-obuf-sap stream) 0 length t)
       (setf (fd-stream-obuf-tail stream) 0))))
 

-(defmacro output-wrapper/variable-width ((stream size buffering)
+(defmacro output-wrapper/variable-width ((stream size buffering restart)

                                         &body body)
   (let ((stream-var (gensym)))
     `(let ((,stream-var ,stream)
                                         &body body)
   (let ((stream-var (gensym)))
     `(let ((,stream-var ,stream)

@@ -210,12 +249,17 @@
                       size))
             (flush-output-buffer ,stream-var)))
       ,(unless (eq (car buffering) :none)
                       size))
             (flush-output-buffer ,stream-var)))
       ,(unless (eq (car buffering) :none)

-        `(when (> (fd-stream-ibuf-tail ,stream-var)
-                  (fd-stream-ibuf-head ,stream-var))
+        `(when (and (not (fd-stream-dual-channel-p ,stream-var))
+                    (> (fd-stream-ibuf-tail ,stream-var)
+                       (fd-stream-ibuf-head ,stream-var)))

             (file-position ,stream-var (file-position ,stream-var))))
             (file-position ,stream-var (file-position ,stream-var))))

-    
-      ,@body
-      (incf (fd-stream-obuf-tail ,stream-var) size)
+      ,(if restart
+           `(catch 'output-nothing
+             ,@body
+             (incf (fd-stream-obuf-tail ,stream-var) size))
+           `(progn
+             ,@body
+             (incf (fd-stream-obuf-tail ,stream-var) size)))

       ,(ecase (car buffering)
         (:none
          `(flush-output-buffer ,stream-var))
       ,(ecase (car buffering)
         (:none
          `(flush-output-buffer ,stream-var))

@@ -225,7 +269,7 @@
         (:full))
     (values))))
 
         (:full))
     (values))))
 

-(defmacro output-wrapper ((stream size buffering) &body body)
+(defmacro output-wrapper ((stream size buffering restart) &body body)

   (let ((stream-var (gensym)))
     `(let ((,stream-var ,stream))
       ,(unless (eq (car buffering) :none)
   (let ((stream-var (gensym)))
     `(let ((,stream-var ,stream))
       ,(unless (eq (car buffering) :none)

@@ -234,12 +278,17 @@
                       ,size))
             (flush-output-buffer ,stream-var)))
       ,(unless (eq (car buffering) :none)
                       ,size))
             (flush-output-buffer ,stream-var)))
       ,(unless (eq (car buffering) :none)

-        `(when (> (fd-stream-ibuf-tail ,stream-var)
-                  (fd-stream-ibuf-head ,stream-var))
+        `(when (and (not (fd-stream-dual-channel-p ,stream-var))
+                    (> (fd-stream-ibuf-tail ,stream-var)
+                       (fd-stream-ibuf-head ,stream-var)))

             (file-position ,stream-var (file-position ,stream-var))))
             (file-position ,stream-var (file-position ,stream-var))))

-    
-      ,@body
-      (incf (fd-stream-obuf-tail ,stream-var) ,size)
+      ,(if restart
+          `(catch 'output-nothing
+             ,@body
+             (incf (fd-stream-obuf-tail ,stream-var) ,size))
+           `(progn
+             ,@body
+             (incf (fd-stream-obuf-tail ,stream-var) ,size)))

       ,(ecase (car buffering)
         (:none
          `(flush-output-buffer ,stream-var))
       ,(ecase (car buffering)
         (:none
          `(flush-output-buffer ,stream-var))

@@ -249,19 +298,18 @@
         (:full))
     (values))))
 
         (:full))
     (values))))
 

-(defmacro def-output-routines/variable-width ((name-fmt size external-format
-                                                       &rest bufferings)
-                                             &body body)
+(defmacro def-output-routines/variable-width
+    ((name-fmt size restart external-format &rest bufferings)
+     &body body)

   (declare (optimize (speed 1)))
   (cons 'progn
        (mapcar
            (lambda (buffering)
              (let ((function
   (declare (optimize (speed 1)))
   (cons 'progn
        (mapcar
            (lambda (buffering)
              (let ((function

-                    (intern (let ((*print-case* :upcase))
-                              (format nil name-fmt (car buffering))))))
+                    (intern (format nil name-fmt (string (car buffering))))))

                `(progn
                   (defun ,function (stream byte)
                `(progn
                   (defun ,function (stream byte)

-                    (output-wrapper/variable-width (stream ,size ,buffering)
+                    (output-wrapper/variable-width (stream ,size ,buffering ,restart)

                       ,@body))
                   (setf *output-routines*
                         (nconc *output-routines*
                       ,@body))
                   (setf *output-routines*
                         (nconc *output-routines*

@@ -277,17 +325,17 @@
 
 ;;; Define output routines that output numbers SIZE bytes long for the
 ;;; given bufferings. Use BODY to do the actual output.
 
 ;;; Define output routines that output numbers SIZE bytes long for the
 ;;; given bufferings. Use BODY to do the actual output.

-(defmacro def-output-routines ((name-fmt size &rest bufferings) &body body)
+(defmacro def-output-routines ((name-fmt size restart &rest bufferings)
+                               &body body)

   (declare (optimize (speed 1)))
   (cons 'progn
        (mapcar
            (lambda (buffering)
              (let ((function
   (declare (optimize (speed 1)))
   (cons 'progn
        (mapcar
            (lambda (buffering)
              (let ((function

-                    (intern (let ((*print-case* :upcase))
-                              (format nil name-fmt (car buffering))))))
+                    (intern (format nil name-fmt (string (car buffering))))))

                `(progn
                   (defun ,function (stream byte)
                `(progn
                   (defun ,function (stream byte)

-                    (output-wrapper (stream ,size ,buffering)
+                    (output-wrapper (stream ,size ,buffering ,restart)

                       ,@body))
                   (setf *output-routines*
                         (nconc *output-routines*
                       ,@body))
                   (setf *output-routines*
                         (nconc *output-routines*

@@ -301,8 +349,10 @@
                                   (cdr buffering)))))))
            bufferings)))
 
                                   (cdr buffering)))))))
            bufferings)))
 

+;;; FIXME: is this used anywhere any more?

 (def-output-routines ("OUTPUT-CHAR-~A-BUFFERED"
                      1
 (def-output-routines ("OUTPUT-CHAR-~A-BUFFERED"
                      1

+                      t

                      (:none character)
                      (:line character)
                      (:full character))
                      (:none character)
                      (:line character)
                      (:full character))

@@ -314,6 +364,7 @@
 
 (def-output-routines ("OUTPUT-UNSIGNED-BYTE-~A-BUFFERED"
                      1
 
 (def-output-routines ("OUTPUT-UNSIGNED-BYTE-~A-BUFFERED"
                      1

+                      nil

                      (:none (unsigned-byte 8))
                      (:full (unsigned-byte 8)))
   (setf (sap-ref-8 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))
                      (:none (unsigned-byte 8))
                      (:full (unsigned-byte 8)))
   (setf (sap-ref-8 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))

@@ -321,6 +372,7 @@
 
 (def-output-routines ("OUTPUT-SIGNED-BYTE-~A-BUFFERED"
                      1
 
 (def-output-routines ("OUTPUT-SIGNED-BYTE-~A-BUFFERED"
                      1

+                      nil

                      (:none (signed-byte 8))
                      (:full (signed-byte 8)))
   (setf (signed-sap-ref-8 (fd-stream-obuf-sap stream)
                      (:none (signed-byte 8))
                      (:full (signed-byte 8)))
   (setf (signed-sap-ref-8 (fd-stream-obuf-sap stream)

@@ -329,6 +381,7 @@
 
 (def-output-routines ("OUTPUT-UNSIGNED-SHORT-~A-BUFFERED"
                      2
 
 (def-output-routines ("OUTPUT-UNSIGNED-SHORT-~A-BUFFERED"
                      2

+                      nil

                      (:none (unsigned-byte 16))
                      (:full (unsigned-byte 16)))
   (setf (sap-ref-16 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))
                      (:none (unsigned-byte 16))
                      (:full (unsigned-byte 16)))
   (setf (sap-ref-16 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))

@@ -336,6 +389,7 @@
 
 (def-output-routines ("OUTPUT-SIGNED-SHORT-~A-BUFFERED"
                      2
 
 (def-output-routines ("OUTPUT-SIGNED-SHORT-~A-BUFFERED"
                      2

+                      nil

                      (:none (signed-byte 16))
                      (:full (signed-byte 16)))
   (setf (signed-sap-ref-16 (fd-stream-obuf-sap stream)
                      (:none (signed-byte 16))
                      (:full (signed-byte 16)))
   (setf (signed-sap-ref-16 (fd-stream-obuf-sap stream)

@@ -344,6 +398,7 @@
 
 (def-output-routines ("OUTPUT-UNSIGNED-LONG-~A-BUFFERED"
                      4
 
 (def-output-routines ("OUTPUT-UNSIGNED-LONG-~A-BUFFERED"
                      4

+                      nil

                      (:none (unsigned-byte 32))
                      (:full (unsigned-byte 32)))
   (setf (sap-ref-32 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))
                      (:none (unsigned-byte 32))
                      (:full (unsigned-byte 32)))
   (setf (sap-ref-32 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))

@@ -351,6 +406,7 @@
 
 (def-output-routines ("OUTPUT-SIGNED-LONG-~A-BUFFERED"
                      4
 
 (def-output-routines ("OUTPUT-SIGNED-LONG-~A-BUFFERED"
                      4

+                      nil

                      (:none (signed-byte 32))
                      (:full (signed-byte 32)))
   (setf (signed-sap-ref-32 (fd-stream-obuf-sap stream)
                      (:none (signed-byte 32))
                      (:full (signed-byte 32)))
   (setf (signed-sap-ref-32 (fd-stream-obuf-sap stream)

@@ -370,8 +426,9 @@
   (let ((start (or start 0))
        (end (or end (length (the (simple-array * (*)) thing)))))
     (declare (type index start end))
   (let ((start (or start 0))
        (end (or end (length (the (simple-array * (*)) thing)))))
     (declare (type index start end))

-    (when (> (fd-stream-ibuf-tail fd-stream)
-            (fd-stream-ibuf-head fd-stream))
+    (when (and (not (fd-stream-dual-channel-p fd-stream))
+              (> (fd-stream-ibuf-tail fd-stream)
+                 (fd-stream-ibuf-head fd-stream)))

       (file-position fd-stream (file-position fd-stream)))
     (let* ((len (fd-stream-obuf-length fd-stream))
           (tail (fd-stream-obuf-tail fd-stream))
       (file-position fd-stream (file-position fd-stream)))
     (let* ((len (fd-stream-obuf-length fd-stream))
           (tail (fd-stream-obuf-tail fd-stream))

@@ -383,38 +440,32 @@
            ((zerop bytes)) ; easy case
            ((<= bytes space)
             (if (system-area-pointer-p thing)
            ((zerop bytes)) ; easy case
            ((<= bytes space)
             (if (system-area-pointer-p thing)

-                (system-area-copy thing
-                                  (* start sb!vm:n-byte-bits)
-                                  (fd-stream-obuf-sap fd-stream)
-                                  (* tail sb!vm:n-byte-bits)
-                                  (* bytes sb!vm:n-byte-bits))
+                (system-area-ub8-copy thing start
+                                       (fd-stream-obuf-sap fd-stream)
+                                       tail
+                                       bytes)

                 ;; FIXME: There should be some type checking somewhere to
                 ;; verify that THING here is a vector, not just <not a SAP>.
                 ;; FIXME: There should be some type checking somewhere to
                 ;; verify that THING here is a vector, not just <not a SAP>.

-                (copy-to-system-area thing
-                                     (+ (* start sb!vm:n-byte-bits)
-                                        (* sb!vm:vector-data-offset
-                                           sb!vm:n-word-bits))
-                                     (fd-stream-obuf-sap fd-stream)
-                                     (* tail sb!vm:n-byte-bits)
-                                     (* bytes sb!vm:n-byte-bits)))
+                (copy-ub8-to-system-area thing start
+                                          (fd-stream-obuf-sap fd-stream)
+                                          tail
+                                          bytes))

             (setf (fd-stream-obuf-tail fd-stream) newtail))
            ((<= bytes len)
             (flush-output-buffer fd-stream)
             (if (system-area-pointer-p thing)
             (setf (fd-stream-obuf-tail fd-stream) newtail))
            ((<= bytes len)
             (flush-output-buffer fd-stream)
             (if (system-area-pointer-p thing)

-                (system-area-copy thing
-                                  (* start sb!vm:n-byte-bits)
-                                  (fd-stream-obuf-sap fd-stream)
-                                  0
-                                  (* bytes sb!vm:n-byte-bits))
+                (system-area-ub8-copy thing
+                                       start
+                                       (fd-stream-obuf-sap fd-stream)
+                                       0
+                                       bytes)

                 ;; FIXME: There should be some type checking somewhere to
                 ;; verify that THING here is a vector, not just <not a SAP>.
                 ;; FIXME: There should be some type checking somewhere to
                 ;; verify that THING here is a vector, not just <not a SAP>.

-                (copy-to-system-area thing
-                                     (+ (* start sb!vm:n-byte-bits)
-                                        (* sb!vm:vector-data-offset
-                                           sb!vm:n-word-bits))
-                                     (fd-stream-obuf-sap fd-stream)
-                                     0
-                                     (* bytes sb!vm:n-byte-bits)))
+                (copy-ub8-to-system-area thing
+                                          start
+                                          (fd-stream-obuf-sap fd-stream)
+                                          0
+                                          bytes))

             (setf (fd-stream-obuf-tail fd-stream) bytes))
            (t
             (flush-output-buffer fd-stream)
             (setf (fd-stream-obuf-tail fd-stream) bytes))
            (t
             (flush-output-buffer fd-stream)

@@ -446,15 +497,15 @@
                                           :end end))))
          (if (and (typep thing 'base-string)
                   (eq (fd-stream-external-format stream) :latin-1))
                                           :end end))))
          (if (and (typep thing 'base-string)
                   (eq (fd-stream-external-format stream) :latin-1))

-         (ecase (fd-stream-buffering stream)
-           (:full
-            (output-raw-bytes stream thing start end))
-           (:line
-            (output-raw-bytes stream thing start end)
-            (when last-newline
-              (flush-output-buffer stream)))
-           (:none
-            (frob-output stream thing start end nil)))
+              (ecase (fd-stream-buffering stream)
+                (:full
+                 (output-raw-bytes stream thing start end))
+                (:line
+                 (output-raw-bytes stream thing start end)
+                 (when last-newline
+                   (flush-output-buffer stream)))
+                (:none
+                 (frob-output stream thing start end nil)))

              (ecase (fd-stream-buffering stream)
                (:full (funcall (fd-stream-output-bytes stream)
                                stream thing nil start end))
              (ecase (fd-stream-buffering stream)
                (:full (funcall (fd-stream-output-bytes stream)
                                stream thing nil start end))

@@ -516,7 +567,7 @@
              (ecase buffering
                (:none
                 (lambda (stream byte)
              (ecase buffering
                (:none
                 (lambda (stream byte)

-                  (output-wrapper (stream (/ i 8) (:none))
+                  (output-wrapper (stream (/ i 8) (:none) nil)

                     (loop for j from 0 below (/ i 8)
                           do (setf (sap-ref-8 
                                     (fd-stream-obuf-sap stream)
                     (loop for j from 0 below (/ i 8)
                           do (setf (sap-ref-8 
                                     (fd-stream-obuf-sap stream)

@@ -524,7 +575,7 @@
                                    (ldb (byte 8 (- i 8 (* j 8))) byte))))))
                (:full
                 (lambda (stream byte)
                                    (ldb (byte 8 (- i 8 (* j 8))) byte))))))
                (:full
                 (lambda (stream byte)

-                  (output-wrapper (stream (/ i 8) (:full))
+                  (output-wrapper (stream (/ i 8) (:full) nil)

                     (loop for j from 0 below (/ i 8)
                           do (setf (sap-ref-8 
                                     (fd-stream-obuf-sap stream)
                     (loop for j from 0 below (/ i 8)
                           do (setf (sap-ref-8 
                                     (fd-stream-obuf-sap stream)

@@ -539,7 +590,7 @@
              (ecase buffering
                (:none
                 (lambda (stream byte)
              (ecase buffering
                (:none
                 (lambda (stream byte)

-                  (output-wrapper (stream (/ i 8) (:none))
+                  (output-wrapper (stream (/ i 8) (:none) nil)

                     (loop for j from 0 below (/ i 8)
                           do (setf (sap-ref-8 
                                     (fd-stream-obuf-sap stream)
                     (loop for j from 0 below (/ i 8)
                           do (setf (sap-ref-8 
                                     (fd-stream-obuf-sap stream)

@@ -547,7 +598,7 @@
                                    (ldb (byte 8 (- i 8 (* j 8))) byte))))))
                (:full
                 (lambda (stream byte)
                                    (ldb (byte 8 (- i 8 (* j 8))) byte))))))
                (:full
                 (lambda (stream byte)

-                  (output-wrapper (stream (/ i 8) (:full))
+                  (output-wrapper (stream (/ i 8) (:full) nil)

                     (loop for j from 0 below (/ i 8)
                           do (setf (sap-ref-8 
                                     (fd-stream-obuf-sap stream)
                     (loop for j from 0 below (/ i 8)
                           do (setf (sap-ref-8 
                                     (fd-stream-obuf-sap stream)

@@ -563,10 +614,10 @@
 ;;; per element.
 (defvar *input-routines* ())
 
 ;;; per element.
 (defvar *input-routines* ())
 

-;;; Fill the input buffer, and return the first character. Throw to
-;;; EOF-INPUT-CATCHER if the eof was reached. Drop into SYSTEM:SERVER
-;;; if necessary.
-(defun frob-input (stream)
+;;; Fill the input buffer, and return the number of bytes read. Throw
+;;; to EOF-INPUT-CATCHER if the eof was reached. Drop into
+;;; SYSTEM:SERVER if necessary.
+(defun refill-buffer/fd (stream)

   (let ((fd (fd-stream-fd stream))
        (ibuf-sap (fd-stream-ibuf-sap stream))
        (buflen (fd-stream-ibuf-length stream))
   (let ((fd (fd-stream-fd stream))
        (ibuf-sap (fd-stream-ibuf-sap stream))
        (buflen (fd-stream-ibuf-length stream))

@@ -581,8 +632,8 @@
             (setf (fd-stream-ibuf-tail stream) 0))
            (t
             (decf tail head)
             (setf (fd-stream-ibuf-tail stream) 0))
            (t
             (decf tail head)

-            (system-area-copy ibuf-sap (* head sb!vm:n-byte-bits)
-                              ibuf-sap 0 (* tail sb!vm:n-byte-bits))
+            (system-area-ub8-copy ibuf-sap head
+                                   ibuf-sap 0 tail)

             (setf head 0)
             (setf (fd-stream-ibuf-head stream) 0)
             (setf (fd-stream-ibuf-tail stream) tail))))
             (setf head 0)
             (setf (fd-stream-ibuf-head stream) 0)
             (setf (fd-stream-ibuf-tail stream) tail))))

@@ -623,17 +674,18 @@
                   (unless (sb!sys:wait-until-fd-usable
                            fd :input (fd-stream-timeout stream))
                     (error 'io-timeout :stream stream :direction :read))
                   (unless (sb!sys:wait-until-fd-usable
                            fd :input (fd-stream-timeout stream))
                     (error 'io-timeout :stream stream :direction :read))

-                  (frob-input stream))
+                  (refill-buffer/fd stream))

                 (simple-stream-perror "couldn't read from ~S" stream errno)))
            ((zerop count)
             (setf (fd-stream-listen stream) :eof)
             (/show0 "THROWing EOF-INPUT-CATCHER")
             (throw 'eof-input-catcher nil))
            (t
                 (simple-stream-perror "couldn't read from ~S" stream errno)))
            ((zerop count)
             (setf (fd-stream-listen stream) :eof)
             (/show0 "THROWing EOF-INPUT-CATCHER")
             (throw 'eof-input-catcher nil))
            (t

-            (incf (fd-stream-ibuf-tail stream) count))))))
+            (incf (fd-stream-ibuf-tail stream) count)
+             count)))))

                        
 ;;; Make sure there are at least BYTES number of bytes in the input
                        
 ;;; Make sure there are at least BYTES number of bytes in the input

-;;; buffer. Keep calling FROB-INPUT until that condition is met.
+;;; buffer. Keep calling REFILL-BUFFER/FD until that condition is met.

 (defmacro input-at-least (stream bytes)
   (let ((stream-var (gensym))
        (bytes-var (gensym)))
 (defmacro input-at-least (stream bytes)
   (let ((stream-var (gensym))
        (bytes-var (gensym)))

@@ -644,11 +696,12 @@
                      (fd-stream-ibuf-head ,stream-var))
                   ,bytes-var)
           (return))
                      (fd-stream-ibuf-head ,stream-var))
                   ,bytes-var)
           (return))

-        (frob-input ,stream-var)))))
+        (refill-buffer/fd ,stream-var)))))

 
 (defmacro input-wrapper/variable-width ((stream bytes eof-error eof-value)
                                        &body read-forms)
   (let ((stream-var (gensym))
 
 (defmacro input-wrapper/variable-width ((stream bytes eof-error eof-value)
                                        &body read-forms)
   (let ((stream-var (gensym))

+       (retry-var (gensym))

        (element-var (gensym)))
     `(let ((,stream-var ,stream)
           (size nil))
        (element-var (gensym)))
     `(let ((,stream-var ,stream)
           (size nil))

@@ -657,14 +710,36 @@
               (fd-stream-unread ,stream-var)
             (setf (fd-stream-unread ,stream-var) nil)
             (setf (fd-stream-listen ,stream-var) nil))
               (fd-stream-unread ,stream-var)
             (setf (fd-stream-unread ,stream-var) nil)
             (setf (fd-stream-listen ,stream-var) nil))

-          (let ((,element-var
-                 (catch 'eof-input-catcher
-                   (input-at-least ,stream-var 1)
-                   (let* ((byte (sap-ref-8 (fd-stream-ibuf-sap ,stream-var)
-                                          (fd-stream-ibuf-head ,stream-var))))
-                     (setq size ,bytes)
-                     (input-at-least ,stream-var size)
-                     (locally ,@read-forms)))))
+          (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 (fd-stream-ibuf-sap
+                                                     ,stream-var)
+                                                    (fd-stream-ibuf-head
+                                                     ,stream-var))))
+                              (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 (- (fd-stream-ibuf-tail ,stream-var)
+                                     (fd-stream-ibuf-head ,stream-var))))
+                  (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 (fd-stream-ibuf-head ,stream-var) size)
                    ,element-var)
             (cond (,element-var
                    (incf (fd-stream-ibuf-head ,stream-var) size)
                    ,element-var)

@@ -818,10 +893,9 @@
   (declare (type index start end))
   (let* ((length (- end start))
         (string (make-string length)))
   (declare (type index start end))
   (let* ((length (- end start))
         (string (make-string length)))

-    (copy-from-system-area sap (* start sb!vm:n-byte-bits)
-                          string (* sb!vm:vector-data-offset
-                                    sb!vm:n-word-bits)
-                          (* length sb!vm:n-byte-bits))
+    (copy-ub8-from-system-area sap start
+                               string 0
+                               length)

     string))
 
 ;;; the N-BIN method for FD-STREAMs
     string))
 
 ;;; the N-BIN method for FD-STREAMs

@@ -831,7 +905,7 @@
 ;;; isn't too problematical.
 (defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p
                               &aux (total-copied 0))
 ;;; isn't too problematical.
 (defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p
                               &aux (total-copied 0))

-  (declare (type file-stream stream))
+  (declare (type fd-stream stream))

   (declare (type index start requested total-copied))
   (let ((unread (fd-stream-unread stream)))
     (when unread
   (declare (type index start requested total-copied))
   (let ((unread (fd-stream-unread stream)))
     (when unread

@@ -870,7 +944,7 @@
             (= total-copied requested)
             (return total-copied))
            (;; If EOF, we're done in another way.
             (= total-copied requested)
             (return total-copied))
            (;; If EOF, we're done in another way.

-            (zerop (refill-fd-stream-buffer stream))
+             (null (catch 'eof-input-catcher (refill-buffer/fd stream)))

             (if eof-error-p
                 (error 'end-of-file :stream stream)
                 (return total-copied)))
             (if eof-error-p
                 (error 'end-of-file :stream stream)
                 (return total-copied)))

@@ -878,69 +952,56 @@
            ;; through into another pass of the loop.
            ))))
 
            ;; through into another pass of the loop.
            ))))
 

-;;; Try to refill the stream buffer. Return the number of bytes read.
-;;; (For EOF, the return value will be zero, otherwise positive.)
-(defun refill-fd-stream-buffer (stream)
-  ;; We don't have any logic to preserve leftover bytes in the buffer,
-  ;; so we should only be called when the buffer is empty.
-  ;; FIXME: can have three bytes in buffer because of UTF-8
-  (let ((new-head 0)
-        (sap (fd-stream-ibuf-sap stream)))
-    (do ((head (fd-stream-ibuf-head stream) (1+ head))
-         (tail (fd-stream-ibuf-tail stream)))
-        ((= head tail))
-      (setf (sap-ref-8 sap new-head) (sap-ref-8 sap head))
-      (incf new-head))
-    (multiple-value-bind (count err)
-        (sb!unix:unix-read (fd-stream-fd stream)
-                           (sap+ sap new-head)
-                           (- (fd-stream-ibuf-length stream) new-head))
-      (declare (type (or index null) count))
-      (when (null count)
-        (simple-stream-perror "couldn't read from ~S" stream err))
-      (setf (fd-stream-listen stream) nil
-            (fd-stream-ibuf-head stream) new-head
-            (fd-stream-ibuf-tail stream) (+ count new-head))
-      count)))
-
-(defmacro define-external-format (external-format size out-expr in-expr)
+(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)))))
+
+;;; 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))
   (let* ((name (first external-format))

-         (out-function (intern (let ((*print-case* :upcase))
-                                 (format nil "OUTPUT-BYTES/~A" name))))
-         (format (format nil "OUTPUT-CHAR-~A-~~A-BUFFERED" name))
-         (in-function (intern (let ((*print-case* :upcase))
-                                (format nil "FD-STREAM-READ-N-CHARACTERS/~A"
-                                        name))))
-         (in-char-function (intern (let ((*print-case* :upcase))
-                                     (format nil "INPUT-CHAR/~A" name)))))
+         (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)))

     `(progn
     `(progn

-      (defun ,out-function (fd-stream string flush-p start end)
+      (defun ,out-function (stream string flush-p start end)

        (let ((start (or start 0))
              (end (or end (length string))))
          (declare (type index start end))
        (let ((start (or start 0))
              (end (or end (length string))))
          (declare (type index start end))

-         (when (> (fd-stream-ibuf-tail fd-stream)
-                  (fd-stream-ibuf-head fd-stream))
-           (file-position fd-stream (file-position fd-stream)))
+         (when (and (not (fd-stream-dual-channel-p stream))
+                    (> (fd-stream-ibuf-tail stream)
+                       (fd-stream-ibuf-head stream)))
+           (file-position stream (file-position stream)))

          (when (< end start)
            (error ":END before :START!"))
          (do ()
              ((= end start))
          (when (< end start)
            (error ":END before :START!"))
          (do ()
              ((= end start))

-           (setf (fd-stream-obuf-tail fd-stream)
-                 (do* ((len (fd-stream-obuf-length fd-stream))
-                       (sap (fd-stream-obuf-sap fd-stream))
-                       (tail (fd-stream-obuf-tail fd-stream)))
+           (setf (fd-stream-obuf-tail stream)
+                 (do* ((len (fd-stream-obuf-length stream))
+                       (sap (fd-stream-obuf-sap stream))
+                       (tail (fd-stream-obuf-tail stream)))

                       ((or (= start end) (< (- len tail) 4)) tail)
                       ((or (= start end) (< (- len tail) 4)) tail)

-                   (let* ((byte (aref string start))
-                          (bits (char-code byte)))
-                     ,out-expr
-                     (incf tail ,size)
-                     (incf start))))
+                    ,(if output-restart
+                        `(catch 'output-nothing
+                           (let* ((byte (aref string start))
+                                  (bits (char-code byte)))
+                             ,out-expr
+                             (incf tail ,size)))
+                         `(let* ((byte (aref string start))
+                                  (bits (char-code byte)))
+                             ,out-expr
+                             (incf tail ,size)))
+                   (incf start)))

            (when (< start end)
            (when (< start end)

-             (flush-output-buffer fd-stream)))
+             (flush-output-buffer stream)))

          (when flush-p
          (when flush-p

-           (flush-output-buffer fd-stream))))
+           (flush-output-buffer stream))))

       (def-output-routines (,format
                            ,size
       (def-output-routines (,format
                            ,size

+                            ,output-restart

                            (:none character)
                            (:line character)
                            (:full character))
                            (:none character)
                            (:line character)
                            (:full character))

@@ -953,7 +1014,7 @@
          ,out-expr))
       (defun ,in-function (stream buffer start requested eof-error-p
                           &aux (total-copied 0))
          ,out-expr))
       (defun ,in-function (stream buffer start requested eof-error-p
                           &aux (total-copied 0))

-       (declare (type file-stream stream))
+       (declare (type fd-stream stream))

        (declare (type index start requested total-copied))
        (let ((unread (fd-stream-unread stream)))
          (when unread
        (declare (type index start requested total-copied))
        (let ((unread (fd-stream-unread stream)))
          (when unread

@@ -982,7 +1043,7 @@
                   (= total-copied requested)
                   (return total-copied))
                  ( ;; If EOF, we're done in another way.
                   (= total-copied requested)
                   (return total-copied))
                  ( ;; If EOF, we're done in another way.

-                  (zerop (refill-fd-stream-buffer stream))
+                   (null (catch 'eof-input-catcher (refill-buffer/fd stream)))

                   (if eof-error-p
                       (error 'end-of-file :stream stream)
                       (return total-copied)))
                   (if eof-error-p
                       (error 'end-of-file :stream stream)
                       (return total-copied)))

@@ -995,29 +1056,27 @@
       (setf *external-formats*
        (cons '(,external-format ,in-function ,in-char-function ,out-function
               ,@(mapcar #'(lambda (buffering)
       (setf *external-formats*
        (cons '(,external-format ,in-function ,in-char-function ,out-function
               ,@(mapcar #'(lambda (buffering)

-                            (intern (let ((*print-case* :upcase))
-                                      (format nil format buffering))))
+                            (intern (format nil format (string buffering))))

                         '(:none :line :full)))
        *external-formats*)))))
 
                         '(:none :line :full)))
        *external-formats*)))))
 

-(defmacro define-external-format/variable-width (external-format out-size-expr
-                                                out-expr in-size-expr in-expr)
+(defmacro define-external-format/variable-width
+    (external-format output-restart out-size-expr
+     out-expr in-size-expr in-expr)

   (let* ((name (first external-format))
   (let* ((name (first external-format))

-        (out-function (intern (let ((*print-case* :upcase))
-                                (format nil "OUTPUT-BYTES/~A" name))))
-        (format (format nil "OUTPUT-CHAR-~A-~~A-BUFFERED" name))
-        (in-function (intern (let ((*print-case* :upcase))
-                               (format nil "FD-STREAM-READ-N-CHARACTERS/~A"
-                                       name))))
-        (in-char-function (intern (let ((*print-case* :upcase))
-                                    (format nil "INPUT-CHAR/~A" name)))))
+        (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))
+        (resync-function (symbolicate "RESYNC/" name)))

     `(progn
       (defun ,out-function (fd-stream string flush-p start end)
        (let ((start (or start 0))
              (end (or end (length string))))
          (declare (type index start end))
     `(progn
       (defun ,out-function (fd-stream string flush-p start end)
        (let ((start (or start 0))
              (end (or end (length string))))
          (declare (type index start end))

-         (when (> (fd-stream-ibuf-tail fd-stream)
-                  (fd-stream-ibuf-head fd-stream))
+         (when (and (not (fd-stream-dual-channel-p fd-stream))
+                    (> (fd-stream-ibuf-tail fd-stream)
+                       (fd-stream-ibuf-head fd-stream)))

            (file-position fd-stream (file-position fd-stream)))
          (when (< end start)
            (error ":END before :START!"))
            (file-position fd-stream (file-position fd-stream)))
          (when (< end start)
            (error ":END before :START!"))

@@ -1028,18 +1087,27 @@
                        (sap (fd-stream-obuf-sap fd-stream))
                        (tail (fd-stream-obuf-tail fd-stream)))
                       ((or (= start end) (< (- len tail) 4)) tail)
                        (sap (fd-stream-obuf-sap fd-stream))
                        (tail (fd-stream-obuf-tail fd-stream)))
                       ((or (= start end) (< (- len tail) 4)) tail)

-                   (let* ((byte (aref string start))
-                          (bits (char-code byte))
-                          (size ,out-size-expr))
-                     ,out-expr
-                     (incf tail size)
-                     (incf start))))
+                   ,(if output-restart
+                        `(catch 'output-nothing
+                           (let* ((byte (aref string start))
+                                  (bits (char-code byte))
+                                  (size ,out-size-expr))
+                             ,out-expr
+                             (incf tail size)
+                             (incf start)))
+                        `(let* ((byte (aref string start))
+                                (bits (char-code byte))
+                                (size ,out-size-expr))
+                           ,out-expr
+                           (incf tail size)))
+                   (incf start)))

            (when (< start end)
              (flush-output-buffer fd-stream)))
          (when flush-p
            (flush-output-buffer fd-stream))))
       (def-output-routines/variable-width (,format
                                           ,out-size-expr
            (when (< start end)
              (flush-output-buffer fd-stream)))
          (when flush-p
            (flush-output-buffer fd-stream))))
       (def-output-routines/variable-width (,format
                                           ,out-size-expr

+                                           ,output-restart

                                           ,external-format
                                           (:none character)
                                           (:line character)
                                           ,external-format
                                           (:none character)
                                           (:line character)

@@ -1053,7 +1121,7 @@
          ,out-expr))
       (defun ,in-function (stream buffer start requested eof-error-p
                           &aux (total-copied 0))
          ,out-expr))
       (defun ,in-function (stream buffer start requested eof-error-p
                           &aux (total-copied 0))

-       (declare (type file-stream stream))
+       (declare (type fd-stream stream))

        (declare (type index start requested total-copied))
        (let ((unread (fd-stream-unread stream)))
          (when unread
        (declare (type index start requested total-copied))
        (let ((unread (fd-stream-unread stream)))
          (when unread

@@ -1065,25 +1133,44 @@
            (nil)
          (let* ((head (fd-stream-ibuf-head stream))
                 (tail (fd-stream-ibuf-tail stream))
            (nil)
          (let* ((head (fd-stream-ibuf-head stream))
                 (tail (fd-stream-ibuf-tail stream))

-                (sap (fd-stream-ibuf-sap stream)))
+                (sap (fd-stream-ibuf-sap stream))
+                (head-start head)
+                (decode-break-reason nil))

            (declare (type index head tail))
            ;; Copy data from stream buffer into user's buffer.
            (declare (type index head tail))
            ;; Copy data from stream buffer into user's buffer.

-           (do ()
+           (do ((size nil nil))

                ((or (= tail head) (= requested total-copied)))
                ((or (= tail head) (= requested total-copied)))

-             (let* ((byte (sap-ref-8 sap head))
-                    (size ,in-size-expr))
-               (when (> size (- tail head))
-                 (return))
-               (setf (aref buffer (+ start total-copied)) ,in-expr)
-               (incf total-copied)
-               (incf head size)))
+             (setf decode-break-reason
+                   (block decode-break-reason
+                     (let ((byte (sap-ref-8 sap head)))
+                       (setq size ,in-size-expr)
+                       (when (> size (- tail head))
+                         (return))
+                       (setf (aref buffer (+ start total-copied)) ,in-expr)
+                       (incf total-copied)
+                       (incf head size))
+                     nil))
+             (setf (fd-stream-ibuf-head stream) head)
+             (when (and decode-break-reason
+                        (= head head-start))
+               (when (stream-decoding-error-and-handle
+                      stream decode-break-reason)
+                 (if eof-error-p
+                     (error 'end-of-file :stream stream)
+                     (return-from ,in-function total-copied)))
+               (setf head (fd-stream-ibuf-head stream))
+               (setf tail (fd-stream-ibuf-tail stream)))
+             (when (plusp total-copied)
+               (return-from ,in-function total-copied)))

            (setf (fd-stream-ibuf-head stream) head)
            ;; Maybe we need to refill the stream buffer.
            (cond ( ;; If there were enough data in the stream buffer, we're done.
                   (= total-copied requested)
                   (return total-copied))
                  ( ;; If EOF, we're done in another way.
            (setf (fd-stream-ibuf-head stream) head)
            ;; Maybe we need to refill the stream buffer.
            (cond ( ;; If there were enough data in the stream buffer, we're done.
                   (= total-copied requested)
                   (return total-copied))
                  ( ;; If EOF, we're done in another way.

-                  (zerop (refill-fd-stream-buffer stream))
+                  (or (eq decode-break-reason 'eof)
+                       (null (catch 'eof-input-catcher 
+                               (refill-buffer/fd stream))))

                   (if eof-error-p
                       (error 'end-of-file :stream stream)
                       (return total-copied)))
                   (if eof-error-p
                       (error 'end-of-file :stream stream)
                       (return total-copied)))

@@ -1096,23 +1183,105 @@
                                                           sap head)
        (let ((byte (sap-ref-8 sap head)))
          ,in-expr))
                                                           sap head)
        (let ((byte (sap-ref-8 sap head)))
          ,in-expr))

+      (defun ,resync-function (stream)
+        (loop (input-at-least stream 1)
+              (incf (fd-stream-ibuf-head stream))
+              (unless (block decode-break-reason
+                       (let* ((sap (fd-stream-ibuf-sap stream))
+                              (head (fd-stream-ibuf-head stream))
+                              (byte (sap-ref-8 sap head))
+                              (size ,in-size-expr))
+                         ,in-expr)
+                       nil)
+                (return))))

       (setf *external-formats*
        (cons '(,external-format ,in-function ,in-char-function ,out-function
               ,@(mapcar #'(lambda (buffering)
       (setf *external-formats*
        (cons '(,external-format ,in-function ,in-char-function ,out-function
               ,@(mapcar #'(lambda (buffering)

-                            (intern (let ((*print-case* :upcase))
-                                      (format nil format buffering))))
-                        '(:none :line :full)))
+                            (intern (format nil format (string buffering))))
+                        '(:none :line :full))
+              ,resync-function)

        *external-formats*)))))
 
        *external-formats*)))))
 

-(define-external-format (:latin-1 :latin1 :iso-8859-1
-                         ;; FIXME: shouldn't ASCII-like things have an
-                         ;; extra typecheck for 7-bitness?
-                         :ascii :us-ascii :ansi_x3.4-1968)
-    1
-  (setf (sap-ref-8 sap tail) bits)
+(define-external-format (:latin-1 :latin1 :iso-8859-1)
+    1 t
+  (if (>= bits 256)
+      (stream-encoding-error-and-handle 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)
+      (stream-encoding-error-and-handle stream bits)
+      (setf (sap-ref-8 sap tail) bits))

   (code-char byte))
 
   (code-char byte))
 

-(define-external-format/variable-width (:utf-8 :utf8)
+(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)
+       (stream-encoding-error-and-handle 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)
+      1 t
+    (setf (sap-ref-8 sap tail)
+          (if (< bits 256)
+              (if (= bits (char-code (aref latin-9-table bits)))
+                  bits
+                  (stream-encoding-error-and-handle stream byte))
+              (if (= (aref latin-9-reverse-1 (logand bits 15)) bits)
+                  (aref latin-9-reverse-2 (logand bits 15))
+                  (stream-encoding-error-and-handle 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)
   (let ((bits (char-code byte)))
     (cond ((< bits #x80) 1)
          ((< bits #x800) 2)

@@ -1130,19 +1299,32 @@
             (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)
             (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)
        ((< byte #xe0) 2)
        ((< byte #xf0) 3)
        (t 4))
   (code-char (ecase size
               (1 byte)

-              (2 (dpb byte (byte 5 6) (sap-ref-8 sap (1+ head))))
-              (3 (dpb byte (byte 4 12)
-                      (dpb (sap-ref-8 sap (1+ head)) (byte 6 6)
-                           (sap-ref-8 sap (+ 2 head)))))
-              (4 (dpb byte (byte 3 18)
-                      (dpb (sap-ref-8 sap (1+ head)) (byte 6 12)
-                           (dpb (sap-ref-8 sap (+ 2 head)) (byte 6 6)
-                                (sap-ref-8 sap (+ 3 head)))))))))
+              (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))))))))

 \f
 ;;;; utility functions (misc routines, etc)
 
 \f
 ;;;; utility functions (misc routines, etc)
 

@@ -1172,18 +1354,29 @@
 
     (when (and character-stream-p
               (eq (fd-stream-external-format fd-stream) :default))
 
     (when (and character-stream-p
               (eq (fd-stream-external-format fd-stream) :default))

+      (/show0 "/getting default external format")

       (setf (fd-stream-external-format fd-stream)
       (setf (fd-stream-external-format fd-stream)

-           (intern (or (alien-funcall
-                        (extern-alien "nl_langinfo"
-                                      (function c-string int))
-                        sb!unix:codeset)
-                       "LATIN-1")
-                   "KEYWORD")))
-    (dolist (entry *external-formats*
-            (setf (fd-stream-external-format fd-stream) :latin-1))
-      (when (member (fd-stream-external-format fd-stream) (first entry))
-       (return)))
-
+            (default-external-format))
+      (/show0 "cold-printing defaulted external-format:")
+      #!+sb-show
+      (cold-print (fd-stream-external-format fd-stream))
+      (/show0 "matching to known aliases")
+      (dolist (entry *external-formats*
+                    (restart-case
+                         (error "Invalid external-format ~A" 
+                                (fd-stream-external-format fd-stream))
+                     (use-default ()
+                        :report "Set external format to LATIN-1"
+                        (setf (fd-stream-external-format fd-stream) :latin-1))))
+        (/show0 "cold printing known aliases:")
+        #!+sb-show
+        (dolist (alias (first entry)) (cold-print alias))
+        (/show0 "done cold-printing known aliases")
+       (when (member (fd-stream-external-format fd-stream) (first entry))
+          (/show0 "matched")
+         (return)))
+      (/show0 "/default external format ok"))
+    

     (when input-p
       (multiple-value-bind (routine type size read-n-characters
                                     normalized-external-format)
     (when input-p
       (multiple-value-bind (routine type size read-n-characters
                                     normalized-external-format)

@@ -1392,7 +1585,7 @@
                                                 0
                                                 0))))
          (cond ((eql count 1)
                                                 0
                                                 0))))
          (cond ((eql count 1)

-                (frob-input fd-stream)
+                (refill-buffer/fd fd-stream)

                 (setf (fd-stream-ibuf-head fd-stream) 0)
                 (setf (fd-stream-ibuf-tail fd-stream) 0))
                (t
                 (setf (fd-stream-ibuf-head fd-stream) 0)
                 (setf (fd-stream-ibuf-tail fd-stream) 0))
                (t

@@ -1406,6 +1599,8 @@
        (sb!sys:serve-all-events)))
     (:element-type
      (fd-stream-element-type fd-stream))
        (sb!sys:serve-all-events)))
     (:element-type
      (fd-stream-element-type fd-stream))

+    (:external-format
+     (fd-stream-external-format fd-stream))

     (:interactive-p
      (= 1 (the (member 0 1)
             (sb!unix:unix-isatty (fd-stream-fd fd-stream)))))
     (:interactive-p
      (= 1 (the (member 0 1)
             (sb!unix:unix-isatty (fd-stream-fd fd-stream)))))

@@ -1421,7 +1616,7 @@
        ;; appropriate value for the EXPECTED-TYPE slot..
        (error 'simple-type-error
               :datum fd-stream
        ;; appropriate value for the EXPECTED-TYPE slot..
        (error 'simple-type-error
               :datum fd-stream

-              :expected-type 'file-stream
+              :expected-type 'fd-stream

               :format-control "~S is not a stream associated with a file."
               :format-arguments (list fd-stream)))
      (multiple-value-bind (okay dev ino mode nlink uid gid rdev size
               :format-control "~S is not a stream associated with a file."
               :format-arguments (list fd-stream)))
      (multiple-value-bind (okay dev ino mode nlink uid gid rdev size

@@ -1434,11 +1629,17 @@
        (if (zerop mode)
           nil
           (truncate size (fd-stream-element-size fd-stream)))))
        (if (zerop mode)
           nil
           (truncate size (fd-stream-element-size fd-stream)))))

+    ;; FIXME: I doubt this is correct in the presence of Unicode,
+    ;; since fd-stream FILE-POSITION is measured in bytes. 
+    (:file-string-length
+     (etypecase arg1
+       (character 1)
+       (string (length arg1))))

     (:file-position
      (fd-stream-file-position fd-stream arg1))))
 
 (defun fd-stream-file-position (stream &optional newpos)
     (:file-position
      (fd-stream-file-position fd-stream arg1))))
 
 (defun fd-stream-file-position (stream &optional newpos)

-  (declare (type file-stream stream)
+  (declare (type fd-stream stream)

           (type (or (alien sb!unix:off-t) (member nil :start :end)) newpos))
   (if (null newpos)
       (sb!sys:without-interrupts
           (type (or (alien sb!unix:off-t) (member nil :start :end)) newpos))
   (if (null newpos)
       (sb!sys:without-interrupts

@@ -1543,6 +1744,7 @@
                       delete-original
                       pathname
                       input-buffer-p
                       delete-original
                       pathname
                       input-buffer-p

+                      dual-channel-p

                       (name (if file
                                 (format nil "file ~S" file)
                                 (format nil "descriptor ~W" fd)))
                       (name (if file
                                 (format nil "file ~S" file)
                                 (format nil "descriptor ~W" fd)))

@@ -1560,6 +1762,7 @@
                                 :delete-original delete-original
                                 :pathname pathname
                                 :buffering buffering
                                 :delete-original delete-original
                                 :pathname pathname
                                 :buffering buffering

+                                :dual-channel-p dual-channel-p

                                 :external-format external-format
                                 :timeout timeout)))
     (set-fd-stream-routines stream element-type input output input-buffer-p)
                                 :external-format external-format
                                 :timeout timeout)))
     (set-fd-stream-routines stream element-type input output input-buffer-p)

@@ -1682,7 +1885,7 @@
       (let ((original (case if-exists
                        ((:rename :rename-and-delete)
                         (pick-backup-name namestring))
       (let ((original (case if-exists
                        ((:rename :rename-and-delete)
                         (pick-backup-name namestring))

-                       ((:append)
+                       ((:append :overwrite)

                         ;; KLUDGE: Provent CLOSE from deleting
                         ;; appending streams when called with :ABORT T
                         namestring)))
                         ;; KLUDGE: Provent CLOSE from deleting
                         ;; appending streams when called with :ABORT T
                         namestring)))

@@ -1753,6 +1956,7 @@
                                      :original original
                                      :delete-original delete-original
                                      :pathname pathname
                                      :original original
                                      :delete-original delete-original
                                      :pathname pathname

+                                     :dual-channel-p nil

                                      :input-buffer-p t
                                      :auto-close t))
                     (:probe
                                      :input-buffer-p t
                                      :auto-close t))
                     (:probe

@@ -1811,7 +2015,8 @@
        (make-fd-stream 1 :name "standard output" :output t :buffering :line))
   (setf *stderr*
        (make-fd-stream 2 :name "standard error" :output t :buffering :line))
        (make-fd-stream 1 :name "standard output" :output t :buffering :line))
   (setf *stderr*
        (make-fd-stream 2 :name "standard error" :output t :buffering :line))

-  (let ((tty (sb!unix:unix-open "/dev/tty" sb!unix:o_rdwr #o666)))
+  (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
     (if tty
        (setf *tty*
              (make-fd-stream tty

@@ -1835,7 +2040,7 @@
 ;;;
 ;;; FIXME: misleading name, screwy interface
 (defun file-name (stream &optional new-name)
 ;;;
 ;;; FIXME: misleading name, screwy interface
 (defun file-name (stream &optional new-name)

-  (when (typep stream 'file-stream)
+  (when (typep stream 'fd-stream)

       (cond (new-name
             (setf (fd-stream-pathname stream) new-name)
             (setf (fd-stream-file stream)
       (cond (new-name
             (setf (fd-stream-pathname stream) new-name)
             (setf (fd-stream-file stream)

@@ -1843,29 +2048,3 @@
             t)
            (t
             (fd-stream-pathname stream)))))
             t)
            (t
             (fd-stream-pathname stream)))))

-\f
-;;;; international character support (which is trivial for our simple
-;;;; character sets)
-
-;;;; (Those who do Lisp only in English might not remember that ANSI
-;;;; requires these functions to be exported from package
-;;;; COMMON-LISP.)
-
-(defun file-string-length (stream object)
-  (declare (type (or string character) object) (type file-stream stream))
-  #!+sb-doc
-  "Return the delta in STREAM's FILE-POSITION that would be caused by writing
-   OBJECT to STREAM. Non-trivial only in implementations that support
-   international character sets."
-  (declare (ignore stream))
-  (etypecase object
-    (character 1)
-    (string (length object))))
-
-(defun stream-external-format (stream)
-  (declare (type file-stream stream))
-  #!+sb-doc
-  "Return the actual external format for file-streams, otherwise :DEFAULT."
-  (if (typep stream 'file-stream)
-      (fd-stream-external-format stream)
-      :default))