1.0.6.36: ALLOW-WITH-INTERRUPTS and interrupt safe WITH-MUTEX &co

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

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 5de405b..50665f7 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -27,12 +27,11 @@
   "Mutex for access to *AVAILABLE-BUFFERS*.")
 
 (defmacro with-available-buffers-lock ((&optional) &body body)
   "Mutex for access to *AVAILABLE-BUFFERS*.")
 
 (defmacro with-available-buffers-lock ((&optional) &body body)

-  ;; WITHOUT-INTERRUPTS because streams are low-level enough to be
+  ;; CALL-WITH-SYSTEM-MUTEX because streams are low-level enough to be

   ;; async signal safe, and in particular a C-c that brings up the
   ;; debugger while holding the mutex would lose badly
   ;; async signal safe, and in particular a C-c that brings up the
   ;; debugger while holding the mutex would lose badly

-  `(without-interrupts
-    (sb!thread:with-mutex (*available-buffers-mutex*)
-      ,@body)))
+  `(sb!thread::call-with-system-mutex (lambda () ,@body)
+                                    *available-buffers-mutex*))

 
 (defconstant bytes-per-buffer (* 4 1024)
   #!+sb-doc
 
 (defconstant bytes-per-buffer (* 4 1024)
   #!+sb-doc

@@ -77,8 +76,9 @@
   ;; sources where input and output aren't related).  non-NIL means
   ;; don't clear input buffer.
   (dual-channel-p nil)
   ;; 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))
+  ;; character position if known -- this may run into bignums, but
+  ;; we probably should flip it into null then for efficiency's sake...
+  (char-pos nil :type (or unsigned-byte null))

   ;; T if input is waiting on FD. :EOF if we hit EOF.
   (listen nil :type (member nil t :eof))
 
   ;; T if input is waiting on FD. :EOF if we hit EOF.
   (listen nil :type (member nil t :eof))
 

@@ -97,8 +97,8 @@
   ;; output flushed, but not written due to non-blocking io?
   (output-later nil)
   (handler nil)
   ;; output flushed, but not written due to non-blocking io?
   (output-later nil)
   (handler nil)

-  ;; timeout specified for this stream, or NIL if none
-  (timeout nil :type (or index null))
+  ;; timeout specified for this stream as seconds or NIL if none
+  (timeout nil :type (or single-float null))

   ;; pathname of the file this stream is opened to (returned by PATHNAME)
   (pathname nil :type (or pathname null))
   (external-format :default)
   ;; pathname of the file this stream is opened to (returned by PATHNAME)
   (pathname nil :type (or pathname null))
   (external-format :default)

@@ -140,6 +140,16 @@
          :stream stream
          :code code))
 
          :stream stream
          :code code))
 

+(defun c-string-encoding-error (external-format code)
+  (error 'c-string-encoding-error
+         :external-format external-format
+         :code code))
+
+(defun c-string-decoding-error (external-format octets)
+  (error 'c-string-decoding-error
+         :external-format external-format
+         :octets octets))
+

 ;;; 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)
 ;;; 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)

@@ -169,6 +179,16 @@
                 (format stream "~@<Skip output of this character.~@:>"))
       (throw 'output-nothing nil))))
 
                 (format stream "~@<Skip output of this character.~@:>"))
       (throw 'output-nothing nil))))
 

+(defun external-format-encoding-error (stream code)
+  (if (streamp stream)
+      (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)))
+

 ;;; 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

@@ -187,7 +207,10 @@
                             start
                             length)
       (cond ((not count)
                             start
                             length)
       (cond ((not count)

-             (if #!-win32 (= errno sb!unix:ewouldblock) #!+win32 t #!-win32
+             #!+win32
+             (simple-stream-perror "couldn't write to ~S" stream errno)
+             #!-win32
+             (if (= errno sb!unix:ewouldblock)

                  (error "Write would have blocked, but SERVER told us to go.")
                  (simple-stream-perror "couldn't write to ~S" stream errno)))
             ((eql count length) ; Hot damn, it worked.
                  (error "Write would have blocked, but SERVER told us to go.")
                  (simple-stream-perror "couldn't write to ~S" stream errno)))
             ((eql count length) ; Hot damn, it worked.

@@ -200,7 +223,7 @@
                          end)
                    (fd-stream-output-later stream))))))
   (unless (fd-stream-output-later stream)
                          end)
                    (fd-stream-output-later stream))))))
   (unless (fd-stream-output-later stream)

-    (sb!sys:remove-fd-handler (fd-stream-handler stream))
+    (remove-fd-handler (fd-stream-handler stream))

     (setf (fd-stream-handler stream) nil)))
 
 ;;; Arange to output the string when we can write on the file descriptor.
     (setf (fd-stream-handler stream) nil)))
 
 ;;; Arange to output the string when we can write on the file descriptor.

@@ -209,7 +232,7 @@
          (setf (fd-stream-output-later stream)
                (list (list base start end reuse-sap)))
          (setf (fd-stream-handler stream)
          (setf (fd-stream-output-later stream)
                (list (list base start end reuse-sap)))
          (setf (fd-stream-handler stream)

-               (sb!sys:add-fd-handler (fd-stream-fd stream)
+               (add-fd-handler (fd-stream-fd stream)

                                       :output
                                       (lambda (fd)
                                         (declare (ignore fd))
                                       :output
                                       (lambda (fd)
                                         (declare (ignore fd))

@@ -230,19 +253,19 @@
            (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.

-      (progn
-        (output-later stream base start end reuse-sap)
-        ;; ### check to see whether any of this noise can be output
-        )
+      (output-later stream base start end reuse-sap)
+      ;; ### check to see whether any of this noise can be output

       (let ((length (- end start)))
         (multiple-value-bind (count errno)
             (sb!unix:unix-write (fd-stream-fd stream) base start length)
           (cond ((not count)
       (let ((length (- end start)))
         (multiple-value-bind (count errno)
             (sb!unix:unix-write (fd-stream-fd stream) base start length)
           (cond ((not count)

-                 (if #!-win32 (= errno sb!unix:ewouldblock) #!+win32 t #!-win32
+                 #!+win32
+                 (simple-stream-perror "Couldn't write to ~S" stream errno)
+                 #!-win32
+                 (if (= errno sb!unix:ewouldblock)

                      (output-later stream base start end reuse-sap)
                      (output-later stream base start end reuse-sap)

-                     (simple-stream-perror "couldn't write to ~S"
-                                           stream
-                                           errno)))
+                     (simple-stream-perror "Couldn't write to ~S"
+                                           stream errno)))

                 ((not (eql count length))
                  (output-later stream base (the index (+ start count))
                                end reuse-sap)))))))
                 ((not (eql count length))
                  (output-later stream base (the index (+ start count))
                                end reuse-sap)))))))

@@ -254,6 +277,10 @@
       (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))))
 

+(defun fd-stream-output-finished-p (stream)
+  (and (zerop (fd-stream-obuf-tail stream))
+       (not (fd-stream-output-later stream))))
+

 (defmacro output-wrapper/variable-width ((stream size buffering restart)
                                          &body body)
   (let ((stream-var (gensym)))
 (defmacro output-wrapper/variable-width ((stream size buffering restart)
                                          &body body)
   (let ((stream-var (gensym)))

@@ -325,6 +352,7 @@
                      (intern (format nil name-fmt (string (car buffering))))))
                 `(progn
                    (defun ,function (stream byte)
                      (intern (format nil name-fmt (string (car buffering))))))
                 `(progn
                    (defun ,function (stream byte)

+                     (declare (ignorable byte))

                      (output-wrapper/variable-width (stream ,size ,buffering ,restart)
                        ,@body))
                    (setf *output-routines*
                      (output-wrapper/variable-width (stream ,size ,buffering ,restart)
                        ,@body))
                    (setf *output-routines*

@@ -429,6 +457,24 @@
                            (fd-stream-obuf-tail stream))
         byte))
 
                            (fd-stream-obuf-tail stream))
         byte))
 

+#+#.(cl:if (cl:= sb!vm:n-word-bits 64) '(and) '(or))
+(progn
+  (def-output-routines ("OUTPUT-UNSIGNED-LONG-LONG-~A-BUFFERED"
+                        8
+                        nil
+                        (:none (unsigned-byte 64))
+                        (:full (unsigned-byte 64)))
+    (setf (sap-ref-64 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))
+          byte))
+  (def-output-routines ("OUTPUT-SIGNED-LONG-LONG-~A-BUFFERED"
+                        8
+                        nil
+                        (:none (signed-byte 64))
+                        (:full (signed-byte 64)))
+    (setf (signed-sap-ref-64 (fd-stream-obuf-sap stream)
+                             (fd-stream-obuf-tail stream))
+          byte)))
+

 ;;; Do the actual output. If there is space to buffer the string,
 ;;; buffer it. If the string would normally fit in the buffer, but
 ;;; doesn't because of other stuff in the buffer, flush the old noise
 ;;; Do the actual output. If there is space to buffer the string,
 ;;; buffer it. If the string would normally fit in the buffer, but
 ;;; doesn't because of other stuff in the buffer, flush the old noise

@@ -491,59 +537,40 @@
 ;;; unbuffered, slam the string down the file descriptor, otherwise
 ;;; use OUTPUT-RAW-BYTES to buffer the string. Update charpos by
 ;;; checking to see where the last newline was.
 ;;; unbuffered, slam the string down the file descriptor, otherwise
 ;;; use OUTPUT-RAW-BYTES to buffer the string. Update charpos by
 ;;; checking to see where the last newline was.

-;;;
-;;; Note: some bozos (the FASL dumper) call write-string with things
-;;; other than strings. Therefore, we must make sure we have a string
-;;; before calling POSITION on it.
-;;; KLUDGE: It would be better to fix the bozos instead of trying to
-;;; cover for them here. -- WHN 20000203

 (defun fd-sout (stream thing start end)
 (defun fd-sout (stream thing start end)

+  (declare (type fd-stream stream) (type string thing))

   (let ((start (or start 0))
         (end (or end (length (the vector thing)))))
     (declare (fixnum start end))
   (let ((start (or start 0))
         (end (or end (length (the vector thing)))))
     (declare (fixnum start end))

-    (if (stringp thing)
-        (let ((last-newline
-               (string-dispatch (simple-base-string
-                                 #!+sb-unicode
-                                 (simple-array character)
-                                 string)
-                   thing
-                 (and (find #\newline thing :start start :end end)
-                      ;; FIXME why do we need both calls?
-                      ;; Is find faster forwards than
-                      ;; position is backwards?
-                      (position #\newline thing
-                                :from-end t
-                                :start start
-                                :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 (funcall (fd-stream-output-bytes stream)
-                                stream thing nil start end))
-                (:line (funcall (fd-stream-output-bytes stream)
-                                stream thing last-newline start end))
-                (:none (funcall (fd-stream-output-bytes stream)
-                                stream thing t start end))))
-          (if last-newline
-              (setf (fd-stream-char-pos stream)
-                    (- end last-newline 1))
-              (incf (fd-stream-char-pos stream)
-                    (- end start))))
-        (ecase (fd-stream-buffering stream)
-          ((:line :full)
-           (output-raw-bytes stream thing start end))
-          (:none
-           (frob-output stream thing start end nil))))))
+    (let ((last-newline
+           (string-dispatch (simple-base-string
+                             #!+sb-unicode
+                             (simple-array character (*))
+                             string)
+               thing
+             (position #\newline thing :from-end t
+                       :start start :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 (funcall (fd-stream-output-bytes stream)
+                            stream thing nil start end))
+            (:line (funcall (fd-stream-output-bytes stream)
+                            stream thing last-newline start end))
+            (:none (funcall (fd-stream-output-bytes stream)
+                            stream thing t start end))))
+      (if last-newline
+          (setf (fd-stream-char-pos stream) (- end last-newline 1))
+          (incf (fd-stream-char-pos stream) (- end start))))))

 
 (defvar *external-formats* ()
   #!+sb-doc
 
 (defvar *external-formats* ()
   #!+sb-doc

@@ -551,13 +578,22 @@
   element-type, string input function name, character input function name,
   and string output function name.")
 
   element-type, string input function name, character input function name,
   and string output function name.")
 

+(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))))
+

 ;;; Find an output routine to use given the type and buffering. Return
 ;;; as multiple values the routine, the real type transfered, and the
 ;;; number of bytes per element.
 (defun pick-output-routine (type buffering &optional external-format)
   (when (subtypep type 'character)
 ;;; Find an output routine to use given the type and buffering. Return
 ;;; as multiple values the routine, the real type transfered, and the
 ;;; number of bytes per element.
 (defun pick-output-routine (type buffering &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-output-routine
           (values (symbol-function (nth (ecase buffering
                                           (:none 4)
         (return-from pick-output-routine
           (values (symbol-function (nth (ecase buffering
                                           (:none 4)

@@ -662,56 +698,80 @@
                              stream
                              errno)))))
 
                              stream
                              errno)))))
 

-;;; 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.
+;;; If the read would block wait (using SERVE-EVENT) till input is available,
+;;; then fill the input buffer, and return the number of bytes read. Throws
+;;; to EOF-INPUT-CATCHER if the eof was reached.

 (defun refill-buffer/fd (stream)
   (let ((fd (fd-stream-fd stream))
 (defun refill-buffer/fd (stream)
   (let ((fd (fd-stream-fd stream))

-        (ibuf-sap (fd-stream-ibuf-sap stream))
-        (buflen (fd-stream-ibuf-length stream))
-        (head (fd-stream-ibuf-head stream))
-        (tail (fd-stream-ibuf-tail stream)))
-    (declare (type index head tail))
-    (unless (zerop head)
-      (cond ((eql head tail)
-             (setf head 0)
-             (setf tail 0)
-             (setf (fd-stream-ibuf-head stream) 0)
-             (setf (fd-stream-ibuf-tail stream) 0))
-            (t
-             (decf tail head)
-             (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 (fd-stream-listen stream) nil)
-    ;;This isn't quite the same on win32.  Then again, neither was
-    ;;(not (sb!win32:fd-listen fd)), as was originally here.  See
-    ;;comment in `sysread-may-block-p'.
-    (when (sysread-may-block-p stream)
-      (unless (sb!sys:wait-until-fd-usable
-               fd :input (fd-stream-timeout stream))
-        (error 'io-timeout :stream stream :direction :read)))
-    (multiple-value-bind (count errno)
-        (sb!unix:unix-read fd
-                           (sb!sys:int-sap (+ (sb!sys:sap-int ibuf-sap) tail))
-                           (- buflen tail))
-      (cond ((null count)
-             (if #!-win32 (eql errno sb!unix:ewouldblock) #!+win32 t #!-win32
-                 (progn
-                   (unless (sb!sys:wait-until-fd-usable
-                            fd :input (fd-stream-timeout stream))
-                     (error 'io-timeout :stream stream :direction :read))
-                   (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
-             (incf (fd-stream-ibuf-tail stream) count)
-             count)))))
+        (errno 0)
+        (count 0))
+    (tagbody
+       ;; Check for blocking input before touching the stream, as if
+       ;; we happen to wait we are liable to be interrupted, and the
+       ;; interrupt handler may use the same stream.
+       (if (sysread-may-block-p stream)
+           (go :wait-for-input)
+           (go :main))
+       ;; These (:CLOSED-FLAME and :READ-ERROR) tags are here so what
+       ;; we can signal errors outside the WITHOUT-INTERRUPTS.
+     :closed-flame
+       (closed-flame stream)
+     :read-error
+       (simple-stream-perror "couldn't read from ~S" stream errno)
+     :wait-for-input
+       ;; This tag is here so we can unwind outside the WITHOUT-INTERRUPTS
+       ;; to wait for input if read tells us EWOULDBLOCK.
+       (unless (wait-until-fd-usable fd :input (fd-stream-timeout stream))
+         (signal-timeout 'io-timeout :stream stream :direction :read
+                         :seconds (fd-stream-timeout stream)))
+     :main
+       ;; Since the read should not block, we'll disable the
+       ;; interrupts here, so that we don't accidentally unwind and
+       ;; leave the stream in an inconsistent state.
+       (without-interrupts
+         (let ((ibuf-sap (fd-stream-ibuf-sap stream))
+               (buflen (fd-stream-ibuf-length stream))
+               (head (fd-stream-ibuf-head stream))
+               (tail (fd-stream-ibuf-tail stream)))
+           (declare (type index head tail))
+           ;; Check the SAP: if it is null, then someone has closed
+           ;; the stream from underneath us. This is not ment to fix
+           ;; multithreaded races, but to deal with interrupt handlers
+           ;; closing the stream.
+           (unless ibuf-sap
+             (go :closed-flame))
+           (unless (zerop head)
+             (cond ((eql head tail)
+                    (setf head 0
+                          tail 0
+                          (fd-stream-ibuf-head stream) 0
+                          (fd-stream-ibuf-tail stream) 0))
+                   (t
+                    (decf tail head)
+                    (system-area-ub8-copy ibuf-sap head
+                                          ibuf-sap 0 tail)
+                    (setf head 0
+                          (fd-stream-ibuf-head stream) 0
+                          (fd-stream-ibuf-tail stream) tail))))
+           (setf (fd-stream-listen stream) nil)
+           (setf (values count errno)
+                 (sb!unix:unix-read fd (int-sap (+ (sap-int ibuf-sap) tail))
+                                    (- buflen tail)))
+           (cond ((null count)
+                  #!+win32
+                  (go :read-error)
+                  #!-win32
+                  (if (eql errno sb!unix:ewouldblock)
+                      (go :wait-for-input)
+                      (go :read-error)))
+                 ((zerop count)
+                  (setf (fd-stream-listen stream) :eof)
+                  (/show0 "THROWing EOF-INPUT-CATCHER")
+                  (throw 'eof-input-catcher nil))
+                 (t
+                  ;; Success!
+                  (incf (fd-stream-ibuf-tail stream) count))))))
+    count))

 
 ;;; Make sure there are at least BYTES number of bytes in the input
 ;;; buffer. Keep calling REFILL-BUFFER/FD until that condition is met.
 
 ;;; Make sure there are at least BYTES number of bytes in the input
 ;;; buffer. Keep calling REFILL-BUFFER/FD until that condition is met.

@@ -752,6 +812,7 @@
                                                       ,stream-var)
                                                      (fd-stream-ibuf-head
                                                       ,stream-var))))
                                                       ,stream-var)
                                                      (fd-stream-ibuf-head
                                                       ,stream-var))))

+                               (declare (ignorable byte))

                                (setq size ,bytes)
                                (input-at-least ,stream-var size)
                                (setq ,element-var (locally ,@read-forms))
                                (setq size ,bytes)
                                (input-at-least ,stream-var size)
                                (setq ,element-var (locally ,@read-forms))

@@ -856,7 +917,14 @@
                    ((signed-byte 32) 4 sap head)
   (signed-sap-ref-32 sap head))
 
                    ((signed-byte 32) 4 sap head)
   (signed-sap-ref-32 sap head))
 

-
+#+#.(cl:if (cl:= sb!vm:n-word-bits 64) '(and) '(or))
+(progn
+  (def-input-routine input-unsigned-64bit-byte
+      ((unsigned-byte 64) 8 sap head)
+    (sap-ref-64 sap head))
+  (def-input-routine input-signed-64bit-byte
+      ((signed-byte 64) 8 sap head)
+    (signed-sap-ref-64 sap head)))

 
 ;;; Find an input routine to use given the type. Return as multiple
 ;;; values the routine, the real type transfered, and the number of
 
 ;;; Find an input routine to use given the type. Return as multiple
 ;;; values the routine, the real type transfered, and the number of

@@ -1001,6 +1069,16 @@
     (when sizer
       (loop for char across string summing (funcall sizer char)))))
 
     (when sizer
       (loop for char across string summing (funcall sizer char)))))
 

+(defun find-external-format (external-format)
+  (when external-format
+    (find external-format *external-formats* :test #'member :key #'car)))
+
+(defun variable-width-external-format-p (ef-entry)
+  (when (eighth ef-entry) t))
+
+(defun bytes-for-char-fun (ef-entry)
+  (if ef-entry (symbol-function (ninth ef-entry)) (constantly 1)))
+

 ;;; FIXME: OAOOM here vrt. *EXTERNAL-FORMAT-FUNCTIONS* in fd-stream.lisp
 (defmacro define-external-format (external-format size output-restart
                                   out-expr in-expr)
 ;;; FIXME: OAOOM here vrt. *EXTERNAL-FORMAT-FUNCTIONS* in fd-stream.lisp
 (defmacro define-external-format (external-format size output-restart
                                   out-expr in-expr)

@@ -1009,7 +1087,10 @@
          (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))
          (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)))
+         (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")))

     `(progn
       (defun ,size-function (byte)
         (declare (ignore byte))
     `(progn
       (defun ,size-function (byte)
         (declare (ignore byte))

@@ -1029,7 +1110,7 @@
             (setf (fd-stream-obuf-tail stream)
                   (string-dispatch (simple-base-string
                                     #!+sb-unicode
             (setf (fd-stream-obuf-tail stream)
                   (string-dispatch (simple-base-string
                                     #!+sb-unicode

-                                    (simple-array character)
+                                    (simple-array character (*))

                                     string)
                       string
                     (let ((len (fd-stream-obuf-length stream))
                                     string)
                       string
                     (let ((len (fd-stream-obuf-length stream))

@@ -1073,9 +1154,11 @@
           ,out-expr))
       (defun ,in-function (stream buffer start requested eof-error-p
                            &aux (index start) (end (+ start requested)))
           ,out-expr))
       (defun ,in-function (stream buffer start requested eof-error-p
                            &aux (index start) (end (+ start requested)))

-        (declare (type fd-stream stream))
-        (declare (type index start requested index end))
-        (declare (type (simple-array character (#.+ansi-stream-in-buffer-length+)) buffer))
+        (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)
         (let ((unread (fd-stream-unread stream)))
           (when unread
             (setf (aref buffer index) unread)

@@ -1113,13 +1196,66 @@
       (def-input-routine ,in-char-function (character ,size sap head)
         (let ((byte (sap-ref-8 sap head)))
           ,in-expr))
       (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)))
+                   ;; This SAP-taking may seem unsafe without pinning,
+                   ;; but since the variable name is a gensym OUT-EXPR
+                   ;; cannot close over it even if it tried, so the buffer
+                   ;; will always be either in a register or on stack.
+                   ;; FIXME: But ...this is true on x86oids only!
+                   (sap (vector-sap ,n-buffer))
+                   (tail 0)
+                   (stream ,name))
+              (declare (type index length tail)
+                       (type 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
       (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)
+               ,size-function ,read-c-string-function ,output-c-string-function)

         *external-formats*)))))
 
 (defmacro define-external-format/variable-width
         *external-formats*)))))
 
 (defmacro define-external-format/variable-width

@@ -1131,9 +1267,13 @@
          (in-function (symbolicate "FD-STREAM-READ-N-CHARACTERS/" name))
          (in-char-function (symbolicate "INPUT-CHAR/" name))
          (resync-function (symbolicate "RESYNC/" name))
          (in-function (symbolicate "FD-STREAM-READ-N-CHARACTERS/" name))
          (in-char-function (symbolicate "INPUT-CHAR/" name))
          (resync-function (symbolicate "RESYNC/" name))

-         (size-function (symbolicate "BYTES-FOR-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")))

     `(progn
       (defun ,size-function (byte)
     `(progn
       (defun ,size-function (byte)

+        (declare (ignorable byte))

         ,out-size-expr)
       (defun ,out-function (stream string flush-p start end)
         (let ((start (or start 0))
         ,out-size-expr)
       (defun ,out-function (stream string flush-p start end)
         (let ((start (or start 0))

@@ -1150,7 +1290,7 @@
             (setf (fd-stream-obuf-tail stream)
                   (string-dispatch (simple-base-string
                                     #!+sb-unicode
             (setf (fd-stream-obuf-tail stream)
                   (string-dispatch (simple-base-string
                                     #!+sb-unicode

-                                    (simple-array character)
+                                    (simple-array character (*))

                                     string)
                       string
                     (let ((len (fd-stream-obuf-length stream))
                                     string)
                       string
                     (let ((len (fd-stream-obuf-length stream))

@@ -1196,9 +1336,11 @@
           ,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 fd-stream stream))
-        (declare (type index start requested total-copied))
-        (declare (type (simple-array character (#.+ansi-stream-in-buffer-length+)) buffer))
+        (declare (type fd-stream stream)
+                 (type index start requested total-copied)
+                 (type
+                  (simple-array character (#.+ansi-stream-in-buffer-length+))
+                  buffer))

         (let ((unread (fd-stream-unread stream)))
           (when unread
             (setf (aref buffer start) unread)
         (let ((unread (fd-stream-unread stream)))
           (when unread
             (setf (aref buffer start) unread)

@@ -1218,6 +1360,7 @@
               (setf decode-break-reason
                     (block decode-break-reason
                       (let ((byte (sap-ref-8 sap head)))
               (setf decode-break-reason
                     (block decode-break-reason
                       (let ((byte (sap-ref-8 sap head)))

+                        (declare (ignorable byte))

                         (setq size ,in-size-expr)
                         (when (> size (- tail head))
                           (return))
                         (setq size ,in-size-expr)
                         (when (> size (- tail head))
                           (return))

@@ -1262,6 +1405,7 @@
                                                            ,in-size-expr
                                                            sap head)
         (let ((byte (sap-ref-8 sap head)))
                                                            ,in-size-expr
                                                            sap head)
         (let ((byte (sap-ref-8 sap head)))

+          (declare (ignorable byte))

           ,in-expr))
       (defun ,resync-function (stream)
         (loop (input-at-least stream 2)
           ,in-expr))
       (defun ,resync-function (stream)
         (loop (input-at-least stream 2)

@@ -1271,19 +1415,103 @@
                                (head (fd-stream-ibuf-head stream))
                                (byte (sap-ref-8 sap head))
                                (size ,in-size-expr))
                                (head (fd-stream-ibuf-head stream))
                                (byte (sap-ref-8 sap head))
                                (size ,in-size-expr))

+                          (declare (ignorable byte))

                           (input-at-least stream size)
                           (let ((sap (fd-stream-ibuf-sap stream))
                                 (head (fd-stream-ibuf-head stream)))
                             ,in-expr))
                         nil)
                 (return))))
                           (input-at-least stream size)
                           (let ((sap (fd-stream-ibuf-sap stream))
                                 (head (fd-stream-ibuf-head stream)))
                             ,in-expr))
                         nil)
                 (return))))

+      (defun ,read-c-string-function (sap element-type)
+        (declare (type system-area-pointer sap))
+        (locally
+            (declare (optimize (speed 3) (safety 0)))
+          (let* ((stream ,name)
+                 (size 0) (head 0) (byte 0) (char nil)
+                 (decode-break-reason nil)
+                 (length (dotimes (count (1- ARRAY-DIMENSION-LIMIT) count)
+                           (setf decode-break-reason
+                                 (block decode-break-reason
+                                   (setf byte (sap-ref-8 sap head)
+                                         size ,in-size-expr
+                                         char ,in-expr)
+                                   (incf head size)
+                                   nil))
+                           (when decode-break-reason
+                             (c-string-decoding-error ,name decode-break-reason))
+                           (when (zerop (char-code char))
+                             (return count))))
+                 (string (make-string length :element-type element-type)))
+            (declare (ignorable stream)
+                     (type index head length) ;; size
+                     (type (unsigned-byte 8) byte)
+                     (type (or null character) char)
+                     (type string string))
+            (setf head 0)
+            (dotimes (index length string)
+              (setf decode-break-reason
+                    (block decode-break-reason
+                      (setf byte (sap-ref-8 sap head)
+                            size ,in-size-expr
+                            char ,in-expr)
+                      (incf head size)
+                      nil))
+              (when decode-break-reason
+                (c-string-decoding-error ,name decode-break-reason))
+              (setf (aref string index) char)))))
+
+      (defun ,output-c-string-function (string)
+        (declare (type simple-string string))
+        (locally
+            (declare (optimize (speed 3) (safety 0)))
+          (let* ((length (length string))
+                 (char-length (make-array (1+ length) :element-type 'index))
+                 (buffer-length
+                  (+ (loop for i of-type index below length
+                        for byte of-type character = (aref string i)
+                        for bits = (char-code byte)
+                        sum (setf (aref char-length i)
+                                  (the index ,out-size-expr)))
+                     (let* ((byte (code-char 0))
+                            (bits (char-code byte)))
+                       (declare (ignorable byte bits))
+                       (setf (aref char-length length)
+                             (the index ,out-size-expr)))))
+                 (tail 0)
+                 (,n-buffer (make-array buffer-length
+                                        :element-type '(unsigned-byte 8)))
+                 ;; This SAP-taking may seem unsafe without pinning,
+                 ;; but since the variable name is a gensym OUT-EXPR
+                 ;; cannot close over it even if it tried, so the buffer
+                 ;; will always be either in a register or on stack.
+                 ;; FIXME: But ...this is true on x86oids only!
+                 (sap (vector-sap ,n-buffer))
+                 stream)
+            (declare (type index length buffer-length tail)
+                     (type system-area-pointer sap)
+                     (type null stream)
+                     (ignorable stream))
+            (loop for i of-type index below length
+                  for byte of-type character = (aref string i)
+                  for bits = (char-code byte)
+                  for size of-type index = (aref char-length i)
+                  do (prog1
+                         ,out-expr
+                       (incf tail size)))
+            (let* ((bits 0)
+                   (byte (code-char bits))
+                   (size (aref char-length length)))
+              (declare (ignorable bits byte size))
+              ,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
       (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)
+               ,size-function ,read-c-string-function ,output-c-string-function)

         *external-formats*)))))
 
 ;;; Multiple names for the :ISO{,-}8859-* families are needed because on
         *external-formats*)))))
 
 ;;; Multiple names for the :ISO{,-}8859-* families are needed because on

@@ -1292,7 +1520,7 @@
 (define-external-format (:latin-1 :latin1 :iso-8859-1 :iso8859-1)
     1 t
   (if (>= bits 256)
 (define-external-format (:latin-1 :latin1 :iso-8859-1 :iso8859-1)
     1 t
   (if (>= bits 256)

-      (stream-encoding-error-and-handle stream bits)
+      (external-format-encoding-error stream bits)

       (setf (sap-ref-8 sap tail) bits))
   (code-char byte))
 
       (setf (sap-ref-8 sap tail) bits))
   (code-char byte))
 

@@ -1300,7 +1528,7 @@
                          :iso-646 :iso-646-us :|646|)
     1 t
   (if (>= bits 128)
                          :iso-646 :iso-646-us :|646|)
     1 t
   (if (>= bits 128)

-      (stream-encoding-error-and-handle stream bits)
+      (external-format-encoding-error stream bits)

       (setf (sap-ref-8 sap tail) bits))
   (code-char byte))
 
       (setf (sap-ref-8 sap tail) bits))
   (code-char byte))
 

@@ -1331,7 +1559,7 @@
   (define-external-format (:ebcdic-us :ibm-037 :ibm037)
       1 t
     (if (>= bits 256)
   (define-external-format (:ebcdic-us :ibm-037 :ibm037)
       1 t
     (if (>= bits 256)

-        (stream-encoding-error-and-handle stream bits)
+        (external-format-encoding-error stream bits)

         (setf (sap-ref-8 sap tail) (aref reverse-table bits)))
     (aref table byte)))
 
         (setf (sap-ref-8 sap tail) (aref reverse-table bits)))
     (aref table byte)))
 

@@ -1362,10 +1590,10 @@
           (if (< bits 256)
               (if (= bits (char-code (aref latin-9-table bits)))
                   bits
           (if (< bits 256)
               (if (= bits (char-code (aref latin-9-table bits)))
                   bits

-                  (stream-encoding-error-and-handle stream byte))
+                  (external-format-encoding-error stream byte))

               (if (= (aref latin-9-reverse-1 (logand bits 15)) bits)
                   (aref latin-9-reverse-2 (logand bits 15))
               (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))))
+                  (external-format-encoding-error stream byte))))

     (aref latin-9-table byte)))
 
 (define-external-format/variable-width (:utf-8 :utf8) nil
     (aref latin-9-table byte)))
 
 (define-external-format/variable-width (:utf-8 :utf8) nil

@@ -1618,7 +1846,7 @@
     (:close
      (cond (arg1                    ; We got us an abort on our hands.
             (when (fd-stream-handler fd-stream)
     (:close
      (cond (arg1                    ; We got us an abort on our hands.
             (when (fd-stream-handler fd-stream)

-              (sb!sys:remove-fd-handler (fd-stream-handler fd-stream))
+              (remove-fd-handler (fd-stream-handler fd-stream))

               (setf (fd-stream-handler fd-stream) nil))
             ;; We can't do anything unless we know what file were
             ;; dealing with, and we don't want to do anything
               (setf (fd-stream-handler fd-stream) nil))
             ;; We can't do anything unless we know what file were
             ;; dealing with, and we don't want to do anything

@@ -1706,10 +1934,7 @@
     (:force-output
      (flush-output-buffer fd-stream))
     (:finish-output
     (:force-output
      (flush-output-buffer fd-stream))
     (:finish-output

-     (flush-output-buffer fd-stream)
-     (do ()
-         ((null (fd-stream-output-later fd-stream)))
-       (sb!sys:serve-all-events)))
+     (finish-fd-stream-output fd-stream))

     (:element-type
      (fd-stream-element-type fd-stream))
     (:external-format
     (:element-type
      (fd-stream-element-type fd-stream))
     (:external-format

@@ -1747,81 +1972,109 @@
        (character (fd-stream-character-size fd-stream arg1))
        (string (fd-stream-string-size fd-stream arg1))))
     (:file-position
        (character (fd-stream-character-size fd-stream arg1))
        (string (fd-stream-string-size fd-stream arg1))))
     (:file-position

-     (fd-stream-file-position fd-stream arg1))))
+     (if arg1
+         (fd-stream-set-file-position fd-stream arg1)
+         (fd-stream-get-file-position fd-stream)))))
+
+;; FIXME: Think about this.
+;;
+;; (defun finish-fd-stream-output (fd-stream)
+;;   (let ((timeout (fd-stream-timeout fd-stream)))
+;;     (loop while (fd-stream-output-later fd-stream)
+;;        ;; FIXME: SIGINT while waiting for a timeout will
+;;        ;; cause a timeout here.
+;;        do (when (and (not (serve-event timeout)) timeout)
+;;             (signal-timeout 'io-timeout
+;;                             :stream fd-stream
+;;                             :direction :write
+;;                             :seconds timeout)))))
+
+(defun finish-fd-stream-output (stream)
+  (flush-output-buffer stream)
+  (do ()
+      ((null (fd-stream-output-later stream)))
+    (serve-all-events)))
+
+(defun fd-stream-get-file-position (stream)
+  (declare (fd-stream stream))
+  (without-interrupts
+    (let ((posn (sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr)))
+      (declare (type (or (alien sb!unix:off-t) null) posn))
+      ;; We used to return NIL for errno==ESPIPE, and signal an error
+      ;; in other failure cases. However, CLHS says to return NIL if
+      ;; the position cannot be determined -- so that's what we do.
+      (when (integerp posn)
+        ;; Adjust for buffered output: If there is any output
+        ;; buffered, the *real* file position will be larger
+        ;; than reported by lseek() because lseek() obviously
+        ;; cannot take into account output we have not sent
+        ;; yet.
+        (dolist (later (fd-stream-output-later stream))
+          (incf posn (- (caddr later) (cadr later))))
+        (incf posn (fd-stream-obuf-tail stream))
+        ;; Adjust for unread input: If there is any input
+        ;; read from UNIX but not supplied to the user of the
+        ;; stream, the *real* file position will smaller than
+        ;; reported, because we want to look like the unread
+        ;; stuff is still available.
+        (decf posn (- (fd-stream-ibuf-tail stream)
+                      (fd-stream-ibuf-head stream)))
+        (when (fd-stream-unread stream)
+          (decf posn))
+        ;; Divide bytes by element size.
+        (truncate posn (fd-stream-element-size stream))))))
+
+(defun fd-stream-set-file-position (stream position-spec)
+  (declare (fd-stream stream))
+  (check-type position-spec
+              (or (alien sb!unix:off-t) (member nil :start :end))
+              "valid file position designator")
+  (tagbody
+   :again
+     ;; Make sure we don't have any output pending, because if we
+     ;; move the file pointer before writing this stuff, it will be
+     ;; written in the wrong location.
+     (finish-fd-stream-output stream)
+     ;; Disable interrupts so that interrupt handlers doing output
+     ;; won't screw us.
+     (without-interrupts
+       (unless (fd-stream-output-finished-p stream)
+         ;; We got interrupted and more output came our way during
+         ;; the interrupt. Wrapping the FINISH-FD-STREAM-OUTPUT in
+         ;; WITHOUT-INTERRUPTS gets nasty as it can signal errors,
+         ;; so we prefer to do things like this...
+         (go :again))
+       ;; Clear out any pending input to force the next read to go to
+       ;; the disk.
+       (setf (fd-stream-unread stream) nil
+             (fd-stream-ibuf-head stream) 0
+             (fd-stream-ibuf-tail stream) 0)
+       ;; Trash cached value for listen, so that we check next time.
+       (setf (fd-stream-listen stream) nil)
+         ;; Now move it.
+         (multiple-value-bind (offset origin)
+             (case position-spec
+           (:start
+            (values 0 sb!unix:l_set))
+           (:end
+            (values 0 sb!unix:l_xtnd))
+           (t
+            (values (* position-spec (fd-stream-element-size stream))
+                    sb!unix:l_set)))
+           (declare (type (alien sb!unix:off-t) offset))
+           (let ((posn (sb!unix:unix-lseek (fd-stream-fd stream)
+                                           offset origin)))
+             ;; CLHS says to return true if the file-position was set
+             ;; succesfully, and NIL otherwise. We are to signal an error
+             ;; only if the given position was out of bounds, and that is
+             ;; dealt with above. In times past we used to return NIL for
+             ;; errno==ESPIPE, and signal an error in other cases.
+             ;;
+             ;; FIXME: We are still liable to signal an error if flushing
+             ;; output fails.
+             (return-from fd-stream-set-file-position
+               (typep posn '(alien sb!unix:off-t))))))))

 
 

-(defun fd-stream-file-position (stream &optional newpos)
-  (declare (type fd-stream stream)
-           (type (or (alien sb!unix:off-t) (member nil :start :end)) newpos))
-  (if (null newpos)
-      (sb!sys:without-interrupts
-        ;; First, find the position of the UNIX file descriptor in the file.
-        (multiple-value-bind (posn errno)
-            (sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr)
-          (declare (type (or (alien sb!unix:off-t) null) posn))
-          (cond ((integerp posn)
-                 ;; Adjust for buffered output: If there is any output
-                 ;; buffered, the *real* file position will be larger
-                 ;; than reported by lseek() because lseek() obviously
-                 ;; cannot take into account output we have not sent
-                 ;; yet.
-                 (dolist (later (fd-stream-output-later stream))
-                   (incf posn (- (caddr later)
-                                 (cadr later))))
-                 (incf posn (fd-stream-obuf-tail stream))
-                 ;; Adjust for unread input: If there is any input
-                 ;; read from UNIX but not supplied to the user of the
-                 ;; stream, the *real* file position will smaller than
-                 ;; reported, because we want to look like the unread
-                 ;; stuff is still available.
-                 (decf posn (- (fd-stream-ibuf-tail stream)
-                               (fd-stream-ibuf-head stream)))
-                 (when (fd-stream-unread stream)
-                   (decf posn))
-                 ;; Divide bytes by element size.
-                 (truncate posn (fd-stream-element-size stream)))
-                ((eq errno sb!unix:espipe)
-                 nil)
-                (t
-                 (sb!sys:with-interrupts
-                   (simple-stream-perror "failure in Unix lseek() on ~S"
-                                         stream
-                                         errno))))))
-      (let ((offset 0) origin)
-        (declare (type (alien sb!unix:off-t) offset))
-        ;; Make sure we don't have any output pending, because if we
-        ;; move the file pointer before writing this stuff, it will be
-        ;; written in the wrong location.
-        (flush-output-buffer stream)
-        (do ()
-            ((null (fd-stream-output-later stream)))
-          (sb!sys:serve-all-events))
-        ;; Clear out any pending input to force the next read to go to
-        ;; the disk.
-        (setf (fd-stream-unread stream) nil)
-        (setf (fd-stream-ibuf-head stream) 0)
-        (setf (fd-stream-ibuf-tail stream) 0)
-        ;; Trash cached value for listen, so that we check next time.
-        (setf (fd-stream-listen stream) nil)
-        ;; Now move it.
-        (cond ((eq newpos :start)
-               (setf offset 0 origin sb!unix:l_set))
-              ((eq newpos :end)
-               (setf offset 0 origin sb!unix:l_xtnd))
-              ((typep newpos '(alien sb!unix:off-t))
-               (setf offset (* newpos (fd-stream-element-size stream))
-                     origin sb!unix:l_set))
-              (t
-               (error "invalid position given to FILE-POSITION: ~S" newpos)))
-        (multiple-value-bind (posn errno)
-            (sb!unix:unix-lseek (fd-stream-fd stream) offset origin)
-          (cond ((typep posn '(alien sb!unix:off-t))
-                 t)
-                ((eq errno sb!unix:espipe)
-                 nil)
-                (t
-                 (simple-stream-perror "error in Unix lseek() on ~S"
-                                       stream
-                                       errno)))))))

 \f
 ;;;; creation routines (MAKE-FD-STREAM and OPEN)
 
 \f
 ;;;; creation routines (MAKE-FD-STREAM and OPEN)
 

@@ -1860,7 +2113,7 @@
                                  (format nil "file ~A" file)
                                  (format nil "descriptor ~W" fd)))
                        auto-close)
                                  (format nil "file ~A" file)
                                  (format nil "descriptor ~W" fd)))
                        auto-close)

-  (declare (type index fd) (type (or index null) timeout)
+  (declare (type index fd) (type (or real null) timeout)

            (type (member :none :line :full) buffering))
   (cond ((not (or input-p output-p))
          (setf input t))
            (type (member :none :line :full) buffering))
   (cond ((not (or input-p output-p))
          (setf input t))

@@ -1875,7 +2128,10 @@
                                  :buffering buffering
                                  :dual-channel-p dual-channel-p
                                  :external-format external-format
                                  :buffering buffering
                                  :dual-channel-p dual-channel-p
                                  :external-format external-format

-                                 :timeout timeout)))
+                                 :timeout
+                                 (if timeout
+                                     (coerce timeout 'single-float)
+                                     nil))))

     (set-fd-stream-routines stream element-type external-format
                             input output input-buffer-p)
     (when (and auto-close (fboundp 'finalize))
     (set-fd-stream-routines stream element-type external-format
                             input output input-buffer-p)
     (when (and auto-close (fboundp 'finalize))

@@ -1890,8 +2146,8 @@
 ;;; Pick a name to use for the backup file for the :IF-EXISTS
 ;;; :RENAME-AND-DELETE and :RENAME options.
 (defun pick-backup-name (name)
 ;;; Pick a name to use for the backup file for the :IF-EXISTS
 ;;; :RENAME-AND-DELETE and :RENAME options.
 (defun pick-backup-name (name)

-  (declare (type simple-base-string name))
-  (concatenate 'simple-base-string name ".bak"))
+  (declare (type simple-string name))
+  (concatenate 'simple-string name ".bak"))

 
 ;;; Ensure that the given arg is one of the given list of valid
 ;;; things. Allow the user to fix any problems.
 
 ;;; Ensure that the given arg is one of the given list of valid
 ;;; things. Allow the user to fix any problems.