From: Daniel Barlow <dan@telent.net>
Date: Sun, 8 Jun 2003 21:24:15 +0000 (+0000)
Subject: 0.8.0.52
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ce58e434470b1ebefae6132d9c075c7d8a2c0c13;p=sbcl.git

0.8.0.52
	large contrib/simple-streams patch including many CMUCL
	changes by Paul Foley
	(Thanks to Rudi Schlatte sbcl-devel 2003.06.08)

	... melded streams are implemented

	... removed device-extend; it's deprecated in acl's
	    simple-streams implementation and will go away there too

	... prettier print-object methods

        ... various small fixes

	... Implemented file-position

	... Removed some sbcl internals redefinition: no need to
	    rewrite unix-lseek, use sb-posix for mmap, munmap

        ... Can now remove sb-grovel requirement too

	... Commented out (but not deleted yet) heavily
	    sbcl-internals-dependent slot access machinery
	    (def-stream-class, with-stream-class, sm).

        ... Various bug fixes, e.g. read-line now works for lines
	    longer than 80 characters
---

diff --git a/contrib/sb-simple-streams/TODO b/contrib/sb-simple-streams/TODO
index 2a9cd73..1cd368f 100644
--- a/contrib/sb-simple-streams/TODO
+++ b/contrib/sb-simple-streams/TODO
@@ -1,15 +1,22 @@
 -*- text -*-
 
-- Writing beyond the end of a mapped-simple-stream is funky; arguably,
-  it should signal an error.
+- Test writing beyond the end of a mapped-simple-stream
 
-- write-octets / read-octets handling of encapsulated streams is
-  untested.
+- Test write-octets / read-octets handling of encapsulated streams
+
+- handle ansi-streams in write-octets / read-octets
 
 - Implement socket-base-simple-stream and chunked transfer encoding.
 
-- Implement string streams.
+- Implement / test string streams.
 
 - Make sure the code examples for stream encapsulation from Franz work
 
 - Test every single output function
+
+- Handle character position (slot charpos)
+
+- make file-position work for non-file streams, where applicable
+
+- make pathname work for simple-streams
+
diff --git a/contrib/sb-simple-streams/cl.lisp b/contrib/sb-simple-streams/cl.lisp
index acd9860..c9b4603 100644
--- a/contrib/sb-simple-streams/cl.lisp
+++ b/contrib/sb-simple-streams/cl.lisp
@@ -8,6 +8,398 @@
 
 (in-package "SB-SIMPLE-STREAMS")
 
+;;; Implementations of standard Common Lisp functions for simple-streams
+
+(defmacro %check-simple-stream (stream &optional direction)
+  ;; Check that STREAM is valid and open in the appropriate direction.
+  `(locally
+     (declare (optimize (speed 3) (space 2) (safety 0) (debug 0)))
+     (with-stream-class (simple-stream ,stream)
+       (let ((flags (sm %flags ,stream)))
+	 (cond ((zerop (logand flags ,(%flags '(:simple))))
+		(error "~S is not properly initialized." stream))
+	       ((zerop (logand flags ,(%flags '(:input :output))))
+		(error "~S is closed." stream))
+	       ,@(when direction
+		   `(((zerop (logand flags ,(%flags (list direction))))
+		      (error ,(format nil "~~S is not an ~(~A~) stream."
+				      direction)
+			     stream)))))))))
+
+
+(defun %simple-stream-file-position (stream position)
+  (if (typep stream 'file-simple-stream)
+      (with-stream-class (file-simple-stream stream)
+        (if (null position)
+            (let ((posn (device-file-position stream)))
+              (when posn
+                ;; Adjust for data read from device but not yet
+                ;; consumed from buffer, or written after the end of
+                ;; the buffer
+                (decf posn (- (sm buffer-ptr stream) (sm buffpos stream))))
+              posn)
+            (progn
+              (setf (sm last-char-read-size stream) 0)
+              (let ((position
+                     (cond ((numberp position) position)
+                           ((eq position :start) 0)
+                           ((eq position :end)
+                            (%simple-stream-file-length stream))
+                           (t (error "Invalid position-spec: ~A" position))))
+                    (device-position (device-file-position stream)))
+                (if (and (<= (- device-position (sm buffer-ptr stream))
+                             position
+                             device-position)
+                         (not (any-stream-instance-flags stream :dirty)))
+                    ;; new position is within buffer; just move pointer
+                    (setf (sm buffpos stream)
+                          (- position (- device-position (sm buffer-ptr stream))))
+                    (progn
+                      (when (any-stream-instance-flags stream :dirty)
+                        (sc-flush-buffer stream t))
+                      (setf (device-file-position stream) position
+                            (sm buffer-ptr stream) 0
+                            (sm buffpos stream) 0)))))))
+      ;; TODO: implement file-position for other types of stream where
+      ;; it makes sense
+      nil))
+
+
+(defun %simple-stream-file-length (stream)
+  (declare (type simple-stream stream))
+  (%check-simple-stream stream)
+  (device-file-length stream)
+  ;; implement me
+  )
+
+
+(defun %simple-stream-file-name (stream)
+  (declare (type simple-stream stream))
+  (if (typep stream 'file-simple-stream)
+      (with-stream-class (file-simple-stream stream)
+	(sm pathname stream))
+      nil))
+
+
+(defun %simple-stream-file-rename (stream new-name)
+  (declare (type simple-stream stream))
+  (if (typep stream 'file-simple-stream)
+      (with-stream-class (file-simple-stream stream)
+	(setf (sm pathname stream) new-name)
+	(setf (sm filename stream) (sb-int:unix-namestring new-name nil))
+	t)
+      nil))
+
+
+(defun %simple-stream-file-string-length (stream object)
+  (declare (type simple-stream stream))
+  (etypecase object
+    (character 1)
+    (string (length object))))
+
+
+(defun %simple-stream-read-char (stream eof-error-p eof-value
+                                 recursive-p blocking-p)
+  (declare (type simple-stream stream)
+	   (ignore recursive-p))
+  (with-stream-class (simple-stream stream)
+    (%check-simple-stream stream :input)
+    (funcall-stm-handler j-read-char (sm melded-stream stream)
+                         eof-error-p eof-value blocking-p)))
+
+
+(defun %simple-stream-unread-char (stream character)
+  (declare (type simple-stream stream) (ignore character))
+  (%check-simple-stream stream :input)
+  (with-stream-class (simple-stream)
+    (if (zerop (sm last-char-read-size stream))
+	(error "Nothing to unread.")
+	(funcall-stm-handler j-unread-char stream nil))))
+
+(defun %simple-stream-peek-char (stream peek-type eof-error-p
+                                 eof-value recursive-p)
+  (declare (type simple-stream stream)
+	   (ignore recursive-p))
+  (with-stream-class (simple-stream stream)
+    (%check-simple-stream stream :input)
+    (let* ((encap (sm melded-stream stream))
+           (char (funcall-stm-handler j-read-char encap
+				     eof-error-p stream t)))
+      (cond ((eq char stream) eof-value)
+	    ((characterp peek-type)
+	     (do ((char char (funcall-stm-handler j-read-char encap
+						  eof-error-p
+						  stream t)))
+		 ((or (eq char stream) (char= char peek-type))
+		  (unless (eq char stream)
+		    (funcall-stm-handler j-unread-char encap t))
+		  (if (eq char stream) eof-value char))))
+	    ((eq peek-type t)
+	     (do ((char char (funcall-stm-handler j-read-char stream
+						  eof-error-p
+						  stream t)))
+		 ((or (eq char stream)
+		      (not (sb-impl::whitespacep char)))
+		  (unless (eq char stream)
+		    (funcall-stm-handler j-unread-char encap t))
+		  (if (eq char stream) eof-value char))))
+	    (t
+	     (funcall-stm-handler j-unread-char encap t)
+	     char)))))
+
+
+(defun %simple-stream-read-line (stream eof-error-p eof-value recursive-p)
+  (declare (type simple-stream stream)
+           (ignore recursive-p)
+	   (optimize (speed 3) (space 2) (safety 0) (debug 0)))
+  (%check-simple-stream stream :input)
+  (with-stream-class (simple-stream stream)
+    (let* ((encap (sm melded-stream stream)) ; encapsulating stream
+           (cbuf (make-string 80))	; current buffer
+	   (bufs (list cbuf))		; list of buffers
+	   (tail bufs)			; last cons of bufs list
+	   (index 0)			; current index in current buffer
+	   (total 0))			; total characters
+      (declare (type simple-stream encap)
+               (type simple-base-string cbuf)
+	       (type cons bufs tail)
+	       (type fixnum index total))
+      (loop
+	(multiple-value-bind (chars done)
+	    (funcall-stm-handler j-read-chars encap cbuf
+				 #\Newline index (length cbuf) t)
+	  (declare (type fixnum chars))
+	  (incf index chars)
+	  (incf total chars)
+	  (when (and (eq done :eof) (zerop index))
+	    (if eof-error-p
+		(error 'end-of-file :stream stream)
+		(return (values eof-value t))))
+	  (when done
+	    ;; If there's only one buffer in use, return it directly
+	    (when (null (cdr bufs))
+	      (return (values (sb-kernel:shrink-vector cbuf index)
+			      (eq done :eof))))
+	    ;; If total fits in final buffer, use it
+	    #+(or)
+	    (when (<= total (length cbuf))
+	      (replace cbuf cbuf :start1 (- total index) :end2 index)
+	      (let ((idx 0))
+		(declare (type fixnum idx))
+		(dolist (buf bufs)
+		  (declare (type simple-base-string buf))
+		  (replace cbuf buf :start1 idx)
+		  (incf idx (length buf))))
+	      (return (values (sb-kernel:shrink-vector cbuf index)
+			      (eq done :eof))))
+	    ;; Allocate new string of appropriate length
+	    (let ((string (make-string total))
+		  (index 0))
+	      (declare (type fixnum index))
+	      (dolist (buf bufs)
+		(declare (type simple-base-string buf))
+		(replace string buf :start1 index)
+		(incf index (length buf)))
+	      (return  (values string (eq done :eof)))))
+	  (when (>= index (length cbuf))
+	    (setf cbuf (make-string (the fixnum (* 2 index))))
+	    (setf index 0)
+	    (setf (cdr tail) (cons cbuf nil))
+	    (setf tail (cdr tail))))))))
+
+
+(defun %simple-stream-listen (stream width)
+  (declare (type simple-stream stream))
+  ;; WIDTH is number of octets which must be available; any value
+  ;; other than 1 is treated as 'character.
+  (%check-simple-stream stream :input)
+  (simple-stream-dispatch stream
+    ;; single-channel-simple-stream
+    (with-stream-class (single-channel-simple-stream stream)
+      (if (not (eql width 1))
+	  (funcall-stm-handler j-listen stream)
+	  (or (< (sm buffpos stream) (sm buffer-ptr stream))
+	      (when (>= (sm mode stream) 0) ;; device-connected
+		(incf (sm last-char-read-size stream))
+		(let ((ok (sc-refill-buffer stream nil)))
+		  (decf (sm last-char-read-size stream))
+		  (plusp ok))))))
+    ;; dual-channel-simple-stream
+    (error "Implement %LISTEN")
+    ;; string-simple-stream
+    (error "Implement %LISTEN")))
+
+
+(defun %simple-stream-clear-input (stream buffer-only)
+  (declare (type simple-stream stream))
+  (%check-simple-stream stream :input)
+  (simple-stream-dispatch stream
+    ;; single-channel-simple-stream
+    (with-stream-class (single-channel-simple-stream stream)
+      (setf (sm buffpos stream) 0
+	    (sm buffer-ptr stream) 0
+	    (sm last-char-read-size stream) 0))
+    ;; dual-channel-simple-stream
+    (with-stream-class (dual-channel-simple-stream stream)
+      (setf (sm buffpos stream) 0
+	    (sm buffer-ptr stream) 0
+	    (sm last-char-read-size stream) 0))
+    ;; string-simple-stream
+    nil)
+  (unless buffer-only (device-clear-input stream buffer-only)))
+
+
+(defun %simple-stream-read-byte (stream eof-error-p eof-value)
+  (declare (type simple-stream stream))
+  (%check-simple-stream stream :input)
+  (with-stream-class (simple-stream stream)
+    (if (any-stream-instance-flags stream :eof)
+	(sb-impl::eof-or-lose stream eof-error-p eof-value)
+	(simple-stream-dispatch stream
+	  ;; single-channel-simple-stream
+	  (sc-read-byte stream eof-error-p eof-value t)
+	  ;; dual-channel-simple-stream
+	  (dc-read-byte stream eof-error-p eof-value t)
+	  ;; string-simple-stream
+	  (with-stream-class (string-simple-stream stream)
+	    (let ((encap (sm input-handle stream)))
+	      (unless encap
+		(error 'simple-type-error
+		       :datum stream
+		       :expected-type 'stream
+		       :format-control "Can't read-byte on string streams"
+		       :format-arguments '()))
+	      (prog1
+		  (locally (declare (notinline read-byte))
+		    (read-byte encap eof-error-p eof-value))
+		(setf (sm last-char-read-size stream) 0
+		      (sm encapsulated-char-read-size stream) 0))))))))
+
+
+(defun %simple-stream-write-char (stream character)
+  (declare (type simple-stream stream))
+  (%check-simple-stream stream :output)
+  (with-stream-class (simple-stream stream)
+    (funcall-stm-handler-2 j-write-char character (sm melded-stream stream))))
+
+
+(defun %simple-stream-fresh-line (stream)
+  (declare (type simple-stream stream))
+  (%check-simple-stream stream :output)
+  (with-stream-class (simple-stream stream)
+    (when (/= (or (sm charpos stream) 1) 0)
+      (funcall-stm-handler-2 j-write-char #\Newline (sm melded-stream stream))
+      t)))
+
+
+(defun %simple-stream-write-string (stream string start end)
+  (declare (type simple-stream stream))
+  (%check-simple-stream stream :output)
+  (with-stream-class (simple-stream stream)
+    (funcall-stm-handler-2 j-write-chars string (sm melded-stream stream)
+                           start end)))
+
+
+(defun %simple-stream-line-length (stream)
+  (declare (type simple-stream stream))
+  (%check-simple-stream stream :output)
+  #| TODO: implement me |#
+  nil  ;; implement me
+  )
+
+
+(defun %simple-stream-finish-output (stream)
+  (declare (type simple-stream stream))
+  (with-stream-class (simple-stream stream)
+    (%check-simple-stream stream :output)
+    (simple-stream-dispatch stream
+      ;; single-channel-simple-stream
+      (sc-flush-buffer stream t)
+      ;; dual-channel-simple-stream
+      (dc-flush-buffer stream t)
+      ;; string-simple-stream
+      nil)))
+
+
+(defun %simple-stream-force-output (stream)
+  (declare (type simple-stream stream))
+  (with-stream-class (simple-stream stream)
+    (%check-simple-stream stream :output)
+    (simple-stream-dispatch stream
+      ;; single-channel-simple-stream
+      (sc-flush-buffer stream nil)
+      ;; dual-channel-simple-stream
+      (dc-flush-buffer stream nil)
+      ;; string-simple-stream
+      nil)))
+
+
+(defun %simple-stream-clear-output (stream)
+  (declare (type simple-stream stream))
+  (%check-simple-stream stream :output)
+  (with-stream-class (simple-stream stream)
+    #| TODO: clear output buffer |#
+    (device-clear-output stream)))
+
+
+(defun %simple-stream-write-byte (stream integer)
+  (declare (type simple-stream stream))
+  (with-stream-class (simple-stream stream)
+    (%check-simple-stream stream :output)
+    (simple-stream-dispatch stream
+      ;; single-channel-simple-stream
+      (with-stream-class (single-channel-simple-stream stream)
+	(let ((ptr (sm buffpos stream)))
+	  (when (>= ptr (sm buffer-ptr stream))
+	    (setf ptr (sc-flush-buffer stream t)))
+          (add-stream-instance-flags stream :dirty)
+	  (setf (sm buffpos stream) (1+ ptr))
+	  (setf (bref (sm buffer stream) ptr) integer)))
+      ;; dual-channel-simple-stream
+      (with-stream-class (dual-channel-simple-stream stream)
+	(let ((ptr (sm outpos stream)))
+	  (when (>= ptr (sm max-out-pos stream))
+	    (setf ptr (dc-flush-buffer stream t)))
+	  (setf (sm outpos stream) (1+ ptr))
+	  (setf (bref (sm out-buffer stream) ptr) integer)))
+      ;; string-simple-stream
+      (error 'simple-type-error
+	     :datum stream
+	     :expected-type 'stream
+	     :format-control "Can't write-byte on string streams."
+	     :format-arguments '()))))
+
+
+(defun %simple-stream-read-sequence (stream seq start end partial-fill)
+  (declare (type simple-stream stream))
+  (with-stream-class (simple-stream stream)
+    (%check-simple-stream stream :input)
+    (etypecase seq
+      (string
+       (funcall-stm-handler j-read-chars (sm melded-stream stream) seq nil
+			    start (or end (length seq))
+			    (if partial-fill :bnb t)))
+      ((or (simple-array (unsigned-byte 8) (*))
+	   (simple-array (signed-byte 8) (*)))
+       ;; TODO: "read-vector" equivalent, but blocking if partial-fill is NIL
+       (error "implement me")
+       ))))
+
+
+(defun %simple-stream-write-sequence (stream seq start end)
+  (declare (type simple-stream stream))
+  (with-stream-class (simple-stream stream)
+    (%check-simple-stream stream :output)
+    (etypecase seq
+      (string
+       (funcall-stm-handler-2 j-write-chars seq (sm melded-stream stream)
+			      start (or end (length seq))))
+      ((or (simple-array (unsigned-byte 8) (*))
+	   (simple-array (signed-byte 8) (*)))
+       ;; "write-vector" equivalent
+       (error "implement me")
+       ))))
+
 
 ;;; Basic functionality for ansi-streams.  These are separate
 ;;; functions because they are called in places where we already know
@@ -97,7 +489,7 @@
 	     ((or (endp rem) (>= i end)) i)
 	   (declare (type list rem)
 		    (type sb-int:index i))
-	   (let ((el (funcall read-function stream nil :eof)))
+	   (let ((el (funcall read-function stream nil :eof nil)))
 	     (when (eq el :eof)
 	       (return i))
 	     (setf (first rem) el)))))
@@ -125,7 +517,7 @@
 	      (do ((i offset-start (1+ i)))
 		  ((>= i offset-end) end)
 		(declare (type sb-int:index i))
-		(let ((el (funcall read-function stream nil :eof)))
+		(let ((el (funcall read-function stream nil :eof nil)))
 		  (when (eq el :eof)
 		    (return (+ start (- i offset-start))))
 		  (setf (aref data i) el)))))))))))
@@ -213,51 +605,50 @@
 
 (defun interactive-stream-p (stream)
   "Return true if Stream does I/O on a terminal or other interactive device."
-  (declare (type stream stream))
   (etypecase stream
     (simple-stream
      (any-stream-instance-flags stream :interactive))
     (ansi-stream
      (funcall (sb-kernel:ansi-stream-misc stream) stream :interactive-p))
-    (fundamental-stream nil)))
+    (fundamental-stream
+     nil)))
 
-(defun (setf interactive-stream-p) (value stream)
+(defun (setf interactive-stream-p) (flag stream)
   (etypecase stream
     (simple-stream
-     (if value
-	 (add-stream-instance-flags stream :interactive)
-	 (remove-stream-instance-flags stream :interactive)))))
+     (if flag
+         (add-stream-instance-flags stream :interactive)
+         (remove-stream-instance-flags stream :interactive)))
+    (t
+     (error 'simple-type-error
+            :datum stream
+            :expected-type 'simple-stream
+            :format-control "Can't set interactive flag on ~S."
+            :format-arguments (list stream)))))
+
+(defun file-string-length (stream object)
+  (declare (type (or string character) object) (type stream stream))
+  "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."
+  (typecase stream
+    (simple-stream (%simple-stream-file-string-length stream object))
+    (t
+     (etypecase object
+       (character 1)
+       (string (length object))))))
 
 (defun stream-external-format (stream)
   "Returns Stream's external-format."
-  (declare (type stream stream))
   (etypecase stream
     (simple-stream
      (with-stream-class (simple-stream)
        (sm external-format stream)))
     (ansi-stream
      :default)
-    (fundamental-stream #| not defined on Gray streams? |#
+    (fundamental-stream
      :default)))
 
-(defgeneric default-open-class (name &optional element-type)
-  (:documentation
-   "Determine the stream class to be created when an attempt is made
-to open NAME.  This is a CMUCL- and SBCL-specific extension to Franz's
-simple-streams proposal.")
-  (:method ((name t) &optional element-type)
-     (declare (ignore element-type))
-     nil)
-  (:method ((name pathname) &optional element-type)
-     (declare (ignore element-type))
-     'sb-sys::file-stream)
-  (:method ((name string) &optional element-type)
-     (declare (ignore element-type))
-     'sb-sys::file-stream)
-  (:method ((name stream) &optional element-type)
-     (declare (ignore element-type))
-     (class-name (class-of name))))
-
 (defun open (filename &rest options
              &key (direction :input)
              (element-type 'character element-type-given)
@@ -279,100 +670,36 @@ simple-streams proposal.")
    :class - class of stream object to be created
    :mapped - T to open a memory-mapped file
    :input-handle - a stream or Unix file descriptor to read from
-   :output-handle - a stream or Unix file descriptor to write to
-
-  If Class is NIL or not supplied, DEFAULT-OPEN-CLASS is called on
-  Filename to determine its value, thus Filename need not be an actual
-  file name; it could be any arbitrary user-defined object for which a
-  method of DEFAULT-OPEN-CLASS is applicable."
-  (declare (ignore if-exists if-does-not-exist external-format
-		   input-handle output-handle))
-  (let ((klass class)
+   :output-handle - a stream or Unix file descriptor to write to"
+  (declare (ignore external-format input-handle output-handle
+                   if-exists if-does-not-exist))
+  (let ((class (or class 'sb-sys::file-stream))
 	(options (copy-list options))
-	(filespec (if (stringp filename) (parse-filespec filename) filename)))
-    (unless klass
-      (setq klass (default-open-class filespec (if element-type-given
-						   element-type
-						   nil))))
-    (unless klass
-      (error 'type-error :datum filename
-	     :expected-type '(or pathname stream base-string)))
-    (cond ((eql klass 'sb-sys::file-stream)
+        (filespec (merge-pathnames filename)))
+    (cond ((eq class 'sb-sys::file-stream)
 	   (remf options :class)
-	   (remf options :mapped)
-	   ;; INPUT-HANDLE and OUTPUT-HANDLE must be fixnums or NIL.
-	   ;; If both are given, they must be the same -- or maybe
-	   ;; we should make a TWO-WAY-STREAM in that case??
-	   ;; If they are given, use SYS:MAKE-FD-STREAM to make the
-	   ;; stream.  Direction must be appropriate, too.
-	   (remf options :input-handle)
-	   (remf options :output-handle)
-	   (apply #'open-fd-stream filespec options))
-	  ((subtypep klass 'simple-stream)
+           (remf options :mapped)
+           (remf options :input-handle)
+           (remf options :output-handle)
+           (apply #'open-fd-stream filespec options))
+	  ((subtypep class 'simple-stream)
 	   (when element-type-given
-	     (error "Can't create simple-streams with an element-type."))
-	   (when (and (eq klass 'file-simple-stream) mapped)
-	     (setq klass 'mapped-file-simple-stream)
-	     (setf (getf options :class) 'mapped-file-simple-stream))
-	   (when (subtypep klass 'file-simple-stream)
-	     (when (eq direction :probe)
-	       (setq klass 'probe-simple-stream)))
-	   (apply #'make-instance klass (list* :filename filespec options)))
-	  ((subtypep klass 'fundamental-stream)
-	   (error "Gray streams are not supported by OPEN."))
-	  (t
-	   (if class
-	       (error "Unable to open streams of class ~S." class)
-	       (error "DEFAULT-OPEN-CLASS method on ~S instances is broken!"
-		      (class-name (class-of filespec))))))))
-
-(defmacro %check-simple-stream (stream &optional direction)
-  ;; Check that STREAM is valid and open in the appropriate direction.
-  `(locally
-     (declare (optimize (speed 3) (space 2) (safety 0) (debug 0)))
-     (with-stream-class (simple-stream ,stream)
-       (let ((flags (sm %flags ,stream)))
-	 (cond ((zerop (logand flags ,(%flags '(:simple))))
-		(error "~S is not properly initialized." stream))
-	       ((zerop (logand flags ,(%flags '(:input :output))))
-		(error "~S is closed." stream))
-	       ,@(when direction
-		   `(((zerop (logand flags ,(%flags (list direction))))
-		      (error ,(format nil "~~S is not an ~(~A~) stream."
-				      direction)
-			     stream)))))))))
+             (error "Can't create simple-streams with an element-type."))
+           (when (and (eq class 'file-simple-stream) mapped)
+             (setq class 'mapped-file-simple-stream)
+             (setf (getf options :class) 'mapped-file-simple-stream))
+           (when (subtypep class 'file-simple-stream)
+             (when (eq direction :probe)
+               (setq class 'probe-simple-stream)))
+           (apply #'make-instance class :filename filespec options))
+	  ((subtypep class 'sb-gray:fundamental-stream)
+	   (remf options :class)
+           (remf options :mapped)
+           (remf options :input-handle)
+           (remf options :output-handle)
+	   (make-instance class :lisp-stream
+                          (apply #'open-fd-stream filespec options))))))
 
-(declaim (inline sc-read-byte dc-read-byte))
-(defun sc-read-byte (stream eof-error-p eof-value blocking)
-  (with-stream-class (single-channel-simple-stream stream)
-    ;; @@1
-    (let ((ptr (sm buffpos stream)))
-      (when (>= ptr (sm buffer-ptr stream))
-	(let ((bytes (device-read stream nil 0 nil blocking)))
-	  (declare (type fixnum bytes))
-	  (if (plusp bytes)
-	      (setf (sm buffer-ptr stream) bytes
-		    ptr 0)
-	      (return-from sc-read-byte
-		(sb-impl::eof-or-lose stream eof-error-p eof-value)))))
-      (setf (sm buffpos stream) (1+ ptr))
-      (setf (sm last-char-read-size stream) 0)
-      (bref (sm buffer stream) ptr))))
-
-(defun dc-read-byte (stream eof-error-p eof-value blocking)
-  (with-stream-class (dual-channel-simple-stream stream)
-    (let ((ptr (sm buffpos stream)))
-      (when (>= ptr (sm buffer-ptr stream))
-	(let ((bytes (device-read stream nil 0 nil blocking)))
-	  (declare (type fixnum bytes))
-	  (if (plusp bytes)
-	      (setf (sm buffer-ptr stream) bytes
-		    ptr 0)
-	      (return-from dc-read-byte
-		(sb-impl::eof-or-lose stream eof-error-p eof-value)))))
-      (setf (sm buffpos stream) (1+ ptr))
-      (setf (sm last-char-read-size stream) 0)
-      (bref (sm buffer stream) ptr))))
 
 (declaim (inline read-byte read-char read-char-no-hang unread-char))
 
@@ -381,24 +708,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::in-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :input)
-       (with-stream-class (simple-stream stream)
-	 (cond ((any-stream-instance-flags stream :eof)
-		(sb-impl::eof-or-lose stream eof-error-p eof-value))
-	       ((any-stream-instance-flags stream :string)
-		(with-stream-class (string-simple-stream stream)
-		  (let ((encap (sm input-handle stream)))
-		    (unless encap
-		      (error "Can't read-byte on string streams"))
-		    (prog1
-			(locally (declare (notinline read-byte))
-			  (read-byte encap eof-error-p eof-value))
-		      (setf (sm last-char-read-size stream) 0
-			    (sm encapsulated-char-read-size stream) 0)))))
-	       ((any-stream-instance-flags stream :dual)
-		(dc-read-byte stream eof-error-p eof-value t))
-	       (t ;; single-channel-simple-stream
-		(sc-read-byte stream eof-error-p eof-value t)))))
+       (%simple-stream-read-byte stream eof-error-p eof-value))
       (ansi-stream
        (%ansi-stream-read-byte stream eof-error-p eof-value t))
       (fundamental-stream
@@ -410,13 +720,10 @@ simple-streams proposal.")
 (defun read-char (&optional (stream *standard-input*) (eof-error-p t)
 			    eof-value recursive-p)
   "Inputs a character from Stream and returns it."
-  (declare (ignore recursive-p))
   (let ((stream (sb-impl::in-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :input)
-       (with-stream-class (simple-stream)
-	 (funcall-stm-handler j-read-char stream eof-error-p eof-value t)))
+       (%simple-stream-read-char stream eof-error-p eof-value recursive-p t))
       (ansi-stream
        (%ansi-stream-read-char stream eof-error-p eof-value t))
       (fundamental-stream
@@ -450,11 +757,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::in-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :input)
-       (with-stream-class (simple-stream)
-	 (if (zerop (sm last-char-read-size stream))
-	     (error "Nothing to unread.")
-	     (funcall-stm-handler j-unread-char stream nil))))
+       (%simple-stream-unread-char stream character))
       (ansi-stream
        (%ansi-stream-unread-char character stream))
       (fundamental-stream
@@ -466,35 +769,11 @@ simple-streams proposal.")
 (defun peek-char (&optional (peek-type nil) (stream *standard-input*)
 			    (eof-error-p t) eof-value recursive-p)
   "Peeks at the next character in the input Stream.  See manual for details."
-  (declare (ignore recursive-p))
   (let ((stream (sb-impl::in-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :input)
-       (with-stream-class (simple-stream)
-	 (let ((char (funcall-stm-handler j-read-char stream
-					  eof-error-p eof-value t)))
-	   (cond ((eq char eof-value) char)
-		 ((characterp peek-type)
-		  (do ((char char (funcall-stm-handler j-read-char stream
-						       eof-error-p
-						       eof-value t)))
-		      ((or (eq char eof-value) (char= char peek-type))
-		       (unless (eq char eof-value)
-			 (funcall-stm-handler j-unread-char stream t))
-		       char)))
-		 ((eq peek-type t)
-		  (do ((char char (funcall-stm-handler j-read-char stream
-						       eof-error-p
-						       eof-value t)))
-		      ((or (eq char eof-value)
-			   (not (sb-int:whitespace-char-p char)))
-		       (unless (eq char eof-value)
-			 (funcall-stm-handler j-unread-char stream t))
-		       char)))
-		 (t
-		  (funcall-stm-handler j-unread-char stream t)
-		  char)))))
+       (%simple-stream-peek-char stream peek-type eof-error-p eof-value
+                                 recursive-p))
       (ansi-stream
        (let ((char (%ansi-stream-read-char stream eof-error-p eof-value t)))
           (cond ((eq char eof-value) char)
@@ -549,17 +828,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::in-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :input)
-       (with-stream-class (simple-stream stream)
-	 (if (not (eql width 1))
-	     (funcall-stm-handler j-listen stream)
-	     (or (< (sm buffpos stream) (sm buffer-ptr stream))
-		 ;; Note: should try DEVICE-EXTEND for more on buffer streams
-		 (when (>= (sm mode stream) 0) ;; device-connected
-		   (incf (sm last-char-read-size stream))
-		   (let ((ok (refill-buffer stream nil)))
-		     (decf (sm last-char-read-size stream))
-		     (plusp ok)))))))
+       (%simple-stream-listen stream width))
       (ansi-stream
        (or (/= (the fixnum (sb-kernel:ansi-stream-in-index stream))
                sb-impl::+ansi-stream-in-buffer-length+)
@@ -569,61 +838,6 @@ simple-streams proposal.")
       (fundamental-stream
        (sb-gray:stream-listen stream)))))
 
-(declaim (inline %simple-stream-read-line))
-(defun %simple-stream-read-line (stream eof-error-p eof-value)
-  (declare (type simple-stream stream)
-	   (optimize (speed 3) (space 2) (safety 0) (debug 0)))
-  (with-stream-class (simple-stream)
-    (let* ((cbuf (make-string 80))	; current buffer
-	   (bufs (list cbuf))		; list of buffers
-	   (tail bufs)			; last cons of bufs list
-	   (index 0)			; current index in current buffer
-	   (total 0))			; total characters
-      (declare (type simple-base-string cbuf)
-	       (type cons bufs tail)
-	       (type fixnum index total))
-      (loop
-	(multiple-value-bind (chars done)
-	    (funcall-stm-handler j-read-chars stream cbuf
-				 #\Newline index (length cbuf) t)
-	  (declare (type fixnum chars))
-	  (incf index chars)
-	  (incf total chars)
-	  (when (and (eq done :eof) (zerop index))
-	    (if eof-error-p
-		(error 'end-of-file :stream stream)
-		(return (values eof-value t))))
-	  (when done
-	    ;; If there's only one buffer in use, return it directly
-	    (when (null (cdr bufs))
-	      (return (values (sb-kernel:shrink-vector cbuf index)
-			      (eq done :eof))))
-	    ;; If total fits in final buffer, use it
-	    #-ignore
-	    (when (<= total (length cbuf))
-	      (replace cbuf cbuf :start1 (- total index) :end2 index)
-	      (let ((idx 0))
-		(declare (type fixnum idx))
-		(dolist (buf bufs)
-		  (declare (type simple-base-string buf))
-		  (replace cbuf buf :start1 idx)
-		  (incf idx (length buf))))
-	      (return (values (sb-kernel:shrink-vector cbuf index)
-			      (eq done :eof))))
-	    ;; Allocate new string of appropriate length
-	    (let ((string (make-string total))
-		  (index 0))
-	      (declare (type fixnum index))
-	      (dolist (buf bufs)
-		(declare (type simple-base-string buf))
-		(replace string buf :start1 index)
-		(incf index (length buf)))
-	      (return  (values string (eq done :eof)))))
-	  (when (>= index (length cbuf))
-	    (setf cbuf (make-string (the fixnum (* 2 index))))
-	    (setf index 0)
-	    (setf (cdr tail) (cons cbuf nil))
-	    (setf tail (cdr tail))))))))
 
 (defun read-line (&optional (stream *standard-input*) (eof-error-p t)
 			    eof-value recursive-p)
@@ -633,8 +847,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::in-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :input)
-       (%simple-stream-read-line stream eof-error-p eof-value))
+       (%simple-stream-read-line stream eof-error-p eof-value recursive-p))
       (ansi-stream
        (%ansi-stream-read-line stream eof-error-p eof-value))
       (fundamental-stream
@@ -655,17 +868,7 @@ simple-streams proposal.")
     (etypecase stream
       (simple-stream
        (with-stream-class (simple-stream stream)
-	 (%check-simple-stream stream :input)
-	 (etypecase seq
-	   (string
-	    (funcall-stm-handler j-read-chars stream seq nil start end
-				 (if partial-fill :bnb t)))
-	   ((or (simple-array (unsigned-byte 8) (*))
-                (simple-array (signed-byte 8) (*)))
-	    ;; TODO: "read-vector" equivalent, but blocking if
-	    ;; partial-fill is NIL
-	    (error "implement me")
-	    ))))
+	 (%simple-stream-read-sequence stream seq start end partial-fill)))
       (ansi-stream
        (%ansi-stream-read-sequence seq stream start end))
       (fundamental-stream
@@ -676,12 +879,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::in-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (with-stream-class (simple-stream stream)
-	 (%check-simple-stream stream :input)
-	 (setf (sm buffpos stream) 0
-	       (sm buffer-ptr stream) 0
-	       (sm last-char-read-size stream) 0) ;; ??
-	 (device-clear-input stream buffer-only)))
+       (%simple-stream-clear-input stream buffer-only))
       (ansi-stream
        (setf (sb-kernel:ansi-stream-in-index stream)
              sb-impl::+ansi-stream-in-buffer-length+)
@@ -695,25 +893,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::out-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       (with-stream-class (simple-stream stream)
-	 (cond ((any-stream-instance-flags stream :string)
-		(error "Can't write-byte on string streams"))
-	       ((any-stream-instance-flags stream :dual)
-		(let ((ptr (sm outpos stream)))
-		  (when (>= ptr (sm max-out-pos stream))
-		    (dc-flush-buffer stream t)
-		    (setf ptr (1- (sm outpos stream))))
-		  (setf (sm outpos stream) (1+ ptr))
-		  (setf (bref (sm out-buffer stream) ptr) integer)))
-	       (t  ;; single-channel-simple-stream
-		(let ((ptr (sm buffpos stream)))
-                  ;; FIXME: Shouldn't this be buf-len, not buffer-ptr?
-		  (when (>= ptr (sm buffer-ptr stream))
-		    (sc-flush-buffer stream t)
-		    (setf ptr (1- (sm buffpos stream))))
-		  (setf (sm buffpos stream) (1+ ptr))
-		  (setf (bref (sm buffer stream) ptr) integer))))))
+       (%simple-stream-write-byte stream integer))
       (ansi-stream
        (funcall (sb-kernel:ansi-stream-bout stream) stream integer))
       (fundamental-stream
@@ -725,9 +905,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::out-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       (with-stream-class (simple-stream stream)
-	 (funcall-stm-handler-2 j-write-char character stream)))
+       (%simple-stream-write-char stream character))
       (ansi-stream
        (funcall (sb-kernel:ansi-stream-out stream) stream character))
       (fundamental-stream
@@ -741,9 +919,7 @@ simple-streams proposal.")
 	(end (or end (length string))))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       (with-stream-class (simple-stream stream)
-	 (funcall-stm-handler-2 j-write-chars string stream start end))
+       (%simple-stream-write-string stream string start end)
        string)
       (ansi-stream
        (%ansi-stream-write-string string stream start end))
@@ -777,16 +953,7 @@ simple-streams proposal.")
 	(end (or end (length seq))))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       (with-stream-class (simple-stream stream)
-	 (etypecase seq
-	   (string
-	    (funcall-stm-handler-2 j-write-chars seq stream start end))
-	   ((or (simple-array (unsigned-byte 8) (*))
-                (simple-array (signed-byte 8) (*)))
-	    ;; TODO: "write-vector" equivalent
-	    (error "implement me")
-	    ))))
+       (%simple-stream-write-sequence stream seq start end))
       (ansi-stream
        (%ansi-stream-write-sequence seq stream start end))
       (fundamental-stream
@@ -812,11 +979,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::out-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       (with-stream-class (simple-stream stream)
-	 (when (/= (or (sm charpos stream) 1) 0)
-	   (funcall-stm-handler-2 j-write-char #\Newline stream)
-	   t)))
+       (%simple-stream-fresh-line stream))
       (ansi-stream
        (when (/= (or (sb-kernel:charpos stream) 1) 0)
 	 (funcall (sb-kernel:ansi-stream-out stream) stream #\Newline)
@@ -830,14 +993,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::out-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       (with-stream-class (simple-stream stream)
-	 (cond ((any-stream-instance-flags stream :string)
-		#| nothing to do |#)
-	       ((any-stream-instance-flags stream :dual)
-		(dc-flush-buffer stream t))
-	       (t
-		(sc-flush-buffer stream t)))))
+       (%simple-stream-finish-output stream))
       (ansi-stream
        (funcall (sb-kernel:ansi-stream-misc stream) stream :finish-output))
       (fundamental-stream
@@ -849,14 +1005,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::out-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       (with-stream-class (simple-stream stream)
-	 (cond ((any-stream-instance-flags stream :string)
-		#| nothing to do |#)
-	       ((any-stream-instance-flags stream :dual)
-		(dc-flush-buffer stream nil))
-	       (t
-		(sc-flush-buffer stream nil)))))
+       (%simple-stream-force-output stream))
       (ansi-stream
        (funcall (sb-kernel:ansi-stream-misc stream) stream :force-output))
       (fundamental-stream
@@ -868,63 +1017,46 @@ simple-streams proposal.")
   (let ((stream (sb-impl::out-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       (with-stream-class (simple-stream stream)
-	 #| clear output buffer |#
-	 (device-clear-output stream)))
+       (%simple-stream-clear-output stream))
       (ansi-stream
        (funcall (sb-kernel:ansi-stream-misc stream) stream :clear-output))
       (fundamental-stream
        (sb-gray:stream-clear-output stream))))
   nil)
 
+
 (defun file-position (stream &optional position)
   "With one argument returns the current position within the file
    File-Stream is open to.  If the second argument is supplied, then
    this becomes the new file position.  The second argument may also
    be :start or :end for the start and end of the file, respectively."
+  (declare (type (or (integer 0 *) (member nil :start :end)) position))
   (etypecase stream
     (simple-stream
-     (%check-simple-stream stream)
-     (cond (position
-	    ;; set unread to zero
-	    ;; if position is within buffer, just move pointer; else
-	    ;; flush output, if necessary
-	    ;; set buffer pointer to 0, to force a read
-	    (setf (device-file-position stream) position))
-	   (t
-	    (let ((posn (device-file-position stream)))
-	      ;; adjust for buffer position
-	      )))
-     #| TODO: implement me |#)
+     (%simple-stream-file-position stream position))
     (ansi-stream
-     (cond (position
-	    (setf (sb-kernel:ansi-stream-in-index stream)
-                  sb-impl::+ansi-stream-in-buffer-length+)
-	    (funcall (sb-kernel:ansi-stream-misc stream)
-		     stream :file-position position))
-	   (t
-	    (let ((res (funcall (sb-kernel:ansi-stream-misc stream)
-				stream :file-position nil)))
-	      (when res
-		(- res
-		   (- sb-impl::+ansi-stream-in-buffer-length+
-		      (sb-kernel:ansi-stream-in-index stream))))))))
-    (fundamental-stream
-     (error "file-position not supported on Gray streams."))))
+     (cond
+       (position
+        (setf (sb-kernel:ansi-stream-in-index stream)
+              sb-impl::+ansi-stream-in-buffer-length+)
+        (funcall (sb-kernel:ansi-stream-misc stream)
+                 stream :file-position position))
+       (t
+        (let ((res (funcall (sb-kernel:ansi-stream-misc stream)
+                            stream :file-position nil)))
+          (when res
+            (- res
+               (- sb-impl::+ansi-stream-in-buffer-length+
+                  (sb-kernel:ansi-stream-in-index stream))))))))))
 
 (defun file-length (stream)
   "This function returns the length of the file that File-Stream is open to."
   (etypecase stream
     (simple-stream
-     (%check-simple-stream stream)
-     (device-file-length stream)
-     #| implement me |#)
+     (%simple-stream-file-length stream))
     (ansi-stream
-     (sb-impl::stream-must-be-associated-with-file stream)
-     (funcall (sb-kernel:ansi-stream-misc stream) stream :file-length))
-    (fundamental-stream
-     (error "file-length not supported on Gray streams."))))
+     (progn (sb-impl::stream-must-be-associated-with-file stream)
+            (funcall (sb-kernel:ansi-stream-misc stream) stream :file-length)))))
 
 (defun line-length (&optional (stream *standard-output*))
   "Returns the number of characters that will fit on a line of output on the
@@ -932,8 +1064,7 @@ simple-streams proposal.")
   (let ((stream (sb-impl::out-synonym-of stream)))
     (etypecase stream
       (simple-stream
-       (%check-simple-stream stream :output)
-       #| implement me |#)
+       (%simple-stream-line-length stream))
       (ansi-stream
        (funcall (sb-kernel:ansi-stream-misc stream) stream :line-length))
       (fundamental-stream
@@ -990,29 +1121,28 @@ simple-streams proposal.")
 	      (length (sb-impl::fd-stream-in-buffer stream)))
 	   (wait-for-input-available (sb-sys:fd-stream-fd stream) timeout))))))
 
-;;;
-;;; SETUP
-;;;
-
-(defmethod shared-initialize :after ((instance simple-stream) slot-names
-				     &rest initargs &key &allow-other-keys)
-  (declare (ignore slot-names))
-  (unless (slot-boundp instance 'melded-stream)
-    (setf (slot-value instance 'melded-stream) instance)
-    (setf (slot-value instance 'melding-base) instance))
-  (unless (device-open instance initargs)
-    (device-close instance t)))
-
-;;; From the simple-streams documentation: "A generic function implies
-;;; a specialization capability that does not exist for
-;;; simple-streams; simple-stream specializations should be on
-;;; device-close."  So don't do it.
-(defmethod close ((stream simple-stream) &key abort)
-  (device-close stream abort))
-
+;; Make PATHNAME and NAMESTRING work
+(defun sb-int:file-name (stream &optional new-name)
+  (typecase stream
+    (file-simple-stream
+     (with-stream-class (file-simple-stream stream)
+       (cond (new-name
+              (%simple-stream-file-rename stream new-name))
+	     (t
+	      (%simple-stream-file-name stream)))))
+    (sb-sys::file-stream
+     (cond (new-name
+	    (setf (sb-impl::fd-stream-pathname stream) new-name)
+	    (setf (sb-impl::fd-stream-file stream)
+		  (sb-int:unix-namestring new-name nil))
+	    t)
+	   (t
+	    (sb-impl::fd-stream-pathname stream))))))
 
 ;;; bugfix
-;;; sat 2003-01-12: What is this for?
+
+;;; TODO: Rudi 2003-01-12: What is this for?  Incorporate into sbcl or
+;;; remove it.
 #+nil
 (defun cl::stream-misc-dispatch (stream operation &optional arg1 arg2)
   (declare (type fundamental-stream stream) ;; this is a lie
diff --git a/contrib/sb-simple-streams/classes.lisp b/contrib/sb-simple-streams/classes.lisp
index 0ad1d44..d11a62a 100644
--- a/contrib/sb-simple-streams/classes.lisp
+++ b/contrib/sb-simple-streams/classes.lisp
@@ -35,7 +35,7 @@
 	     (values fixnum &optional (member nil t :eof))))
 
 (deftype j-write-char-fn ()
-  '(function (character simple-stream) character))
+  '(function ((or character null) simple-stream) (or character null)))
 
 (deftype j-write-chars-fn ()
   '(function (string simple-stream fixnum fixnum) t)) ;; return chars-written?
@@ -66,6 +66,9 @@
   (defvar *slot-access-functions* (make-hash-table))
   (defvar *automagic-accessors* nil))
 
+;;; Commented out in favor of standard class machinery that does not
+;;; depend on implementation internals.
+#+nil
 (defmacro def-stream-class (name superclasses slots &rest options)
   (let ((accessors ())
 	(real-slots ()))
@@ -123,6 +126,12 @@
 	      collect `(setf (gethash ',(car accessor) *slot-access-functions*)
 			     ',(cdr accessor)))))))
 
+
+(defmacro def-stream-class (name superclasses slots &rest options)
+  (let ((slots (copy-tree slots)))
+    (dolist (slot slots) (remf (cdr slot) 'sb-pcl::location))
+    `(defclass ,name ,superclasses ,slots ,@options)))
+
 (def-stream-class simple-stream (standard-object stream)
   ((plist :initform nil :type list :accessor stream-plist sb-pcl::location 19)
 
@@ -131,17 +140,17 @@
 
    ;; A function that determines if one character can be successfully
    ;; read from stream.
-   (j-listen :type j-listen-fn sb-pcl::location 18)
+   (j-listen :initform #'sb-kernel:ill-in :type j-listen-fn sb-pcl::location 18)
    ;; A function that reads one character.
-   (j-read-char :type j-read-char-fn sb-pcl::location 17)
+   (j-read-char :initform #'sb-kernel:ill-in :type j-read-char-fn sb-pcl::location 17)
    ;; A function that reads characters into a string.
-   (j-read-chars :type j-read-chars-fn sb-pcl::location 16)
+   (j-read-chars :initform #'sb-kernel:ill-in :type j-read-chars-fn sb-pcl::location 16)
    ;; A function that writes one character.
-   (j-write-char :type j-write-char-fn sb-pcl::location 15)
+   (j-write-char :initform #'sb-kernel:ill-out :type j-write-char-fn sb-pcl::location 15)
    ;; A function that writes characters from a string into the stream.
-   (j-write-chars :type j-write-chars-fn sb-pcl::location 14)
+   (j-write-chars :initform #'sb-kernel:ill-out :type j-write-chars-fn sb-pcl::location 14)
    ;; A function that unreads the last character read.
-   (j-unread-char :type j-unread-char-fn sb-pcl::location 13)
+   (j-unread-char :initform #'sb-kernel:ill-in :type j-unread-char-fn sb-pcl::location 13)
 
    ;; Other slots
 
@@ -211,10 +220,11 @@
   ())
 
 (def-stream-class file-simple-stream (single-channel-simple-stream)
-  ((pathname :initform nil :initarg :pathname)
-   (filename :initform nil :initarg :filename)
-   (original :initform nil :initarg :original)
-   (delete-original :initform nil :initarg :delete-original)
+  ((pathname :initform nil :initarg :pathname sb-pcl::location 27)
+   (filename :initform nil :initarg :filename sb-pcl::location 26)
+   (original :initform nil :initarg :original sb-pcl::location 25)
+   (delete-original :initform nil :initarg :delete-original
+                    sb-pcl::location 24)
    ))
 
 (def-stream-class mapped-file-simple-stream (file-simple-stream
@@ -224,8 +234,8 @@
 ;;; A stream with two octet buffers, for example a socket or terminal
 ;;; stream.
 (def-stream-class dual-channel-simple-stream (simple-stream)
-  ;; Output buffer.
-  ((out-buffer :initform nil :type (or simple-stream-buffer null)
+  (;; Output buffer.
+   (out-buffer :initform nil :type (or simple-stream-buffer null)
 	       sb-pcl::location 26)
    ;; Current position in output buffer.
    (outpos :initform 0 :type fixnum sb-pcl::location 25)
@@ -256,8 +266,14 @@
 
 ;;; A stream with a string as buffer.
 (def-stream-class string-simple-stream (simple-stream)
-  ;; The input/output buffer.
-  ((buffer :initform nil :type (or simple-stream-buffer null)
+  ())
+
+(def-stream-class composing-stream (string-simple-stream)
+  ())
+
+(def-stream-class string-input-simple-stream (string-simple-stream)
+  (;; The input buffer.
+   (buffer :initform nil :type (or simple-stream-buffer null)
            sb-pcl::location 23)
    ;; Current position in buffer.
    (buffpos :initform 0 :type fixnum sb-pcl::location 22)
@@ -265,22 +281,24 @@
    (buffer-ptr :initform 0 :type fixnum sb-pcl::location 21)
    (buf-len :initform 0 :type fixnum sb-pcl::location 20)))
 
-(def-stream-class composing-stream (string-simple-stream)
-  ())
-
-(def-stream-class string-input-simple-stream (string-simple-stream)
-  ())
-
 (def-stream-class string-output-simple-stream (string-simple-stream)
-  ;; The output buffer (slot added so that a class can inherit from
-  ;; both string-input-simple-stream and string-output-simple-stream
-  ;; without the strategies clashing)
-  ((out-buffer :initform nil :type (or simple-stream-buffer null)
-	       sb-pcl::location 26)
+  (;; The input buffer.
+   (buffer :initform nil :type (or simple-stream-buffer null)
+            sb-pcl::location 26)
+   ;; Current position in input buffer.
+   (buffpos :initform 0 :type fixnum  sb-pcl::location 25)
+   ;; Maximum valid position in input buffer, or -1 on eof.
+   (buffer-ptr :initform 0 :type fixnum  sb-pcl::location 24)
+   (buf-len :initform 0 :type fixnum sb-pcl::location 23)
+   ;; The output buffer (slot added so that a class can inherit from
+   ;; both string-input-simple-stream and string-output-simple-stream
+   ;; without the strategies clashing)
+   (out-buffer :initform nil :type (or simple-stream-buffer null)
+                sb-pcl::location 22)
    ;; Current position in output buffer.
-   (outpos :initform 0 :type fixnum sb-pcl::location 25)
+   (outpos :initform 0 :type fixnum sb-pcl::location 21)
    ;; Buffer length (one greater than maximum output buffer index)
-   (max-out-pos :initform 0 :type fixnum sb-pcl::location 24)))
+   (max-out-pos :initform 0 :type fixnum sb-pcl::location 20)))
 
 (def-stream-class fill-pointer-output-simple-stream
     (string-output-simple-stream)
@@ -329,6 +347,4 @@
 
 (defgeneric device-clear-output (stream))
 
-(defgeneric device-extend (stream need action))
-
 (defgeneric device-finish-record (stream blocking action))
diff --git a/contrib/sb-simple-streams/constants.lisp b/contrib/sb-simple-streams/constants.lisp
deleted file mode 100644
index 663726b..0000000
--- a/contrib/sb-simple-streams/constants.lisp
+++ /dev/null
@@ -1,27 +0,0 @@
-;;; -*- Lisp -*-
-
-;;; This code is in the public domain.
-
-;;; The cmucl implementation of simple-streams was done by Paul Foley,
-;;; who placed the code in the public domain.  Sbcl port by Rudi
-;;; Schlatte.
-
-;;; Some constants that are not (yet?) in sbcl itself.  Basically,
-;;; constants needed for calling mmap from sbcl.
-
-;;; TODO (Rudi 2003-05-12): The contents of this file, along with
-;;; unix.lisp, should presumably end up somewhere else, either in sbcl
-;;; itself or in sb-posix.
-
-("stdio.h" "sys/types.h" "sys/stat.h" "fcntl.h" "errno.h" "sys/mman.h")
-
-((:integer eacces "EACCES" "Error code for access error")
- (:integer prot-none "PROT_NONE" "mmap: no protection")
- (:integer prot-read "PROT_READ" "mmap: read protection")
- (:integer prot-write "PROT_WRITE" "mmap: write protection")
- (:integer prot-exec "PROT_EXEC" "mmap: execute protection")
- (:integer map-shared "MAP_SHARED" "mmap: shared memory")
- (:integer map-private "MAP_PRIVATE" "mmap: private mapping")
- (:integer map-fixed "MAP_FIXED" "mmap: map at given location"))
-
-
diff --git a/contrib/sb-simple-streams/internal.lisp b/contrib/sb-simple-streams/internal.lisp
index 4f79d4b..bf4a78e 100644
--- a/contrib/sb-simple-streams/internal.lisp
+++ b/contrib/sb-simple-streams/internal.lisp
@@ -45,10 +45,14 @@
 ;;; forms, the inner with-stream-class form must specify a stream
 ;;; argument if the outer one specifies one, or the wrong object will
 ;;; be accessed.
+
+;;; Commented out in favor of standard class machinery that does not
+;;; depend on implementation internals.
+#+nil
 (defmacro with-stream-class ((class-name &optional stream) &body body)
   (if stream
       (let ((stm (gensym "STREAM"))
-	    (slt (gensym)))
+	    (slt (gensym "SV")))
 	`(let* ((,stm ,stream)
 		(,slt (sb-pcl::std-instance-slots ,stm)))
 	   (declare (type ,class-name ,stm) (ignorable ,slt))
@@ -95,6 +99,45 @@
 			    (t `(slot-value ,stream ',slot-name))))))
 	 ,@body)))
 
+
+(defmacro with-stream-class ((class-name &optional stream) &body body)
+  (if stream
+    (let ((stm (gensym "STREAM"))
+	  (slt (gensym "SV")))
+      `(let* ((,stm ,stream)
+	      (,slt (sb-kernel:%instance-ref ,stm 1)))
+	 (declare (type ,class-name ,stm)
+		  (type simple-vector ,slt)
+		  (ignorable ,slt))
+	 (macrolet ((sm (slot-name stream)
+		      (declare (ignore stream))
+		      #-count-sm
+		      `(slot-value ,',stm ',slot-name)
+		      #+count-sm
+		      `(%sm ',slot-name ,',stm))
+		    (add-stream-instance-flags (stream &rest flags)
+		      (declare (ignore stream))
+		      `(setf (sm %flags ,',stm) (logior (sm %flags ,',stm)
+							,(%flags flags))))
+		    (remove-stream-instance-flags (stream &rest flags)
+		      (declare (ignore stream))
+		      `(setf (sm %flags ,',stm) (logandc2 (sm %flags ,',stm)
+							  ,(%flags flags))))
+		    (any-stream-instance-flags (stream &rest flags)
+		      (declare (ignore stream))
+		      `(not (zerop (logand (sm %flags ,',stm)
+					   ,(%flags flags))))))
+	   ,@body)))
+    `(macrolet ((sm (slot-name stream)
+		  #-count-sm
+		  `(slot-value ,stream ',slot-name)
+		  #+count-sm
+		  `(%sm ',slot-name ,stream)))
+       ,@body)))
+
+;;; Commented out in favor of standard class machinery that does not
+;;; depend on implementation internals.
+#+nil
 (defmacro sm (slot-name stream)
   (let ((slot-access (gethash slot-name *slot-access-functions*)))
     (warn "Using ~S macro outside ~S" 'sm 'with-stream-class)
@@ -106,6 +149,12 @@
 	   `(the ,(car slot-access) (,(cdr slot-access) ,stream)))
 	  (t `(slot-value ,stream ',slot-name)))))
 
+
+(defmacro sm (slot-name stream)
+  "Access the named slot in Stream."
+  (warn "Using ~S macro outside ~S." 'sm 'with-stream-class)
+  `(slot-value ,stream ',slot-name))
+
 (defmacro funcall-stm-handler (slot-name stream &rest args)
   (let ((s (gensym)))
     `(let ((,s ,stream))
@@ -137,6 +186,17 @@
        (with-stream-class (simple-stream ,s)
 	 (not (zerop (logand (sm %flags ,s) ,(%flags flags))))))))
 
+(defmacro simple-stream-dispatch (stream single dual string)
+  (let ((s (gensym "STREAM")))
+    `(let ((,s ,stream))
+       (with-stream-class (simple-stream ,s)
+	 (let ((%flags (sm %flags ,s)))
+	   (cond ((zerop (logand %flags ,(%flags '(:string :dual))))
+		  ,single)
+		 ((zerop (logand %flags ,(%flags '(:string))))
+		  ,dual)
+		 (t
+		  ,string)))))))
 
 (declaim (inline buffer-sap bref (setf bref) buffer-copy))
 
@@ -173,7 +233,7 @@
       (make-array size :element-type '(unsigned-byte 8))))
 
 (defun free-buffer (buffer)
-  (when (not (vectorp buffer))
+  (when (sb-sys:system-area-pointer-p buffer)
     (push buffer sb-impl::*available-buffers*))
   t)
 
@@ -207,9 +267,7 @@
 	       ((:rename :rename-and-delete)
 		(setf mask (logior mask sb-unix:o_creat)))
 	       ((:new-version :supersede)
-		(setf mask (logior mask sb-unix:o_trunc)))
-	       (:append
-		(setf mask (logior mask sb-unix:o_append)))))
+		(setf mask (logior mask sb-unix:o_trunc)))))
 	    (t
 	     (setf if-exists nil)))	; :ignore-this-arg
       (unless if-does-not-exist-given
@@ -282,6 +340,8 @@
 		  (sb-unix:unix-open name mask mode)
 		  (values nil sb-unix:enoent))
 	    (cond ((sb-int:fixnump fd)
+                   (when (eql if-exists :append)
+                     (sb-unix:unix-lseek fd 0 sb-unix:l_xtnd))
 		   (return (values fd name original delete-original)))
 		  ((eql errno sb-unix:enoent)
 		   (case if-does-not-exist
@@ -341,50 +401,30 @@
 			 :overwrite :append :supersede nil) if-exists)
 	   (type (member :error :create nil) if-does-not-exist)
 	   (ignore external-format))
-  (setq pathname (pathname pathname))
-  (multiple-value-bind (fd namestring original delete-original)
-      (%fd-open pathname direction if-exists if-exists-given
-		if-does-not-exist if-does-not-exist-given)
-    (when fd
-      (case direction
-	((:input :output :io)
-	 (sb-sys:make-fd-stream fd
-                                :input (member direction '(:input :io))
-                                :output (member direction '(:output :io))
-                                :element-type element-type
-                                :file namestring
-                                :original original
-                                :delete-original delete-original
-                                :pathname pathname
-                                :input-buffer-p t
-                                :auto-close t))
-	(:probe
-	 (let ((stream (sb-impl::%make-fd-stream :name namestring :fd fd
-                                                 :pathname pathname
-                                                 :element-type element-type)))
-	   (close stream)
-	   stream))))))
-
-
-;; Make PATHNAME and NAMESTRING work
-(defun cl::file-name (stream &optional new-name)
-  (typecase stream
-    (file-simple-stream
-     (with-stream-class (file-simple-stream stream)
-       (cond (new-name
-	      (setf (sm pathname stream) new-name)
-	      (setf (sm filename stream) (sb-int:unix-namestring new-name nil))
-	      t)
-	     (t
-	      (sm pathname stream)))))
-    (sb-sys::file-stream
-     (cond (new-name
-	    (setf (sb-impl::fd-stream-pathname stream) new-name)
-	    (setf (sb-impl::fd-stream-file stream)
-		  (sb-int:unix-namestring new-name nil))
-	    t)
-	   (t
-	    (sb-impl::fd-stream-pathname stream))))))
+  (let ((filespec (merge-pathnames pathname)))
+    (multiple-value-bind (fd namestring original delete-original)
+        (%fd-open filespec direction if-exists if-exists-given
+                  if-does-not-exist if-does-not-exist-given)
+      (when fd
+        (case direction
+          ((:input :output :io)
+           (sb-sys:make-fd-stream fd
+                                  :input (member direction '(:input :io))
+                                  :output (member direction '(:output :io))
+                                  :element-type element-type
+                                  :file namestring
+                                  :original original
+                                  :delete-original delete-original
+                                  :pathname pathname
+                                  :input-buffer-p t
+                                  :auto-close t))
+          (:probe
+           (let ((stream (sb-impl::%make-fd-stream :name namestring :fd fd
+                                                   :pathname pathname
+                                                   :element-type element-type)))
+             (close stream)
+             stream)))))))
+
 
 ;; Experimental "filespec" stuff
 
diff --git a/contrib/sb-simple-streams/sb-simple-streams.asd b/contrib/sb-simple-streams/sb-simple-streams.asd
index e22e85b..a9445bd 100644
--- a/contrib/sb-simple-streams/sb-simple-streams.asd
+++ b/contrib/sb-simple-streams/sb-simple-streams.asd
@@ -1,27 +1,20 @@
 ;;; -*- lisp -*-
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (require :sb-grovel))
-(defpackage #:sb-simple-stream-system (:use #:asdf #:cl #:sb-grovel))
+(defpackage #:sb-simple-stream-system (:use #:asdf #:cl))
 (in-package #:sb-simple-stream-system)
 
 
 (defsystem sb-simple-streams
-  :depends-on (sb-grovel sb-bsd-sockets)
+  :depends-on (sb-bsd-sockets sb-posix)
   :components ((:file "package")
                (:file "fndb")
-               (grovel-constants-file "constants"
-                                      :package :sb-simple-streams
-                                      :pathname "constants.lisp"
-                                      :depends-on ("package"))
-               (:file "unix" :depends-on ("constants"))
                ;;(:file "pcl")
                ;;(:file "ext-format" :depends-on ("package"))
                (:file "classes" :depends-on ("package"))
                (:file "internal" :depends-on ("classes"))
                (:file "strategy" :depends-on ("internal"))
                (:file "cl" :depends-on ("internal" "fndb"))
-               (:file "simple-streams" :depends-on ("cl" "strategy" "unix"))
+               (:file "simple-streams" :depends-on ("cl" "strategy"))
                ;;(:file "gray-compat" :depends-on ("package"))
                ;;(:file "iodefs" :depends-on ("package"))
                ))
diff --git a/contrib/sb-simple-streams/simple-stream-tests.lisp b/contrib/sb-simple-streams/simple-stream-tests.lisp
index 735b154..010d0ab 100644
--- a/contrib/sb-simple-streams/simple-stream-tests.lisp
+++ b/contrib/sb-simple-streams/simple-stream-tests.lisp
@@ -7,7 +7,7 @@
 (in-package #:sb-simple-streams-test)
 
 (defparameter *dumb-string*
-  "This file created by simple-stream-tests.lisp. Nothing to see here, move along.")
+  "This file was created by simple-stream-tests.lisp. Nothing to see here, move along.")
 
 (defparameter *test-path*
   (merge-pathnames (make-pathname :name nil :type nil :version nil)
@@ -16,6 +16,28 @@
 
 (eval-when (:load-toplevel) (ensure-directories-exist *test-path*))
 
+(defmacro with-test-file ((stream file &rest open-arguments
+                                  &key (delete-afterwards t)
+                                  initial-content
+                                  &allow-other-keys)
+                          &body body)
+  (remf open-arguments :delete-afterwards)
+  (remf open-arguments :initial-content)
+  (if initial-content
+      (let ((create-file-stream (gensym)))
+        `(progn
+           (with-open-file (,create-file-stream ,file :direction :output
+                                                :if-exists :supersede
+                                                :if-does-not-exist :create)
+             (write-sequence ,initial-content ,create-file-stream))
+           (unwind-protect
+                (with-open-file (,stream ,file ,@open-arguments)
+                  (progn ,@body))
+             ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
+      `(unwind-protect
+            (with-open-file (,stream ,file ,@open-arguments)
+              (progn ,@body))
+         ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
 
 
 (deftest create-file-1
@@ -25,7 +47,8 @@
         (with-open-stream (s (make-instance 'file-simple-stream
                                             :filename file
                                             :direction :output
-                                            :if-exists :overwrite))
+                                            :if-exists :overwrite
+                                            :if-does-not-exist :create))
           (string= (write-string *dumb-string* s) *dumb-string*))
       (delete-file file)))
   t)
@@ -33,29 +56,24 @@
 (deftest create-file-2
   ;; Create a file-simple-stream via :class argument to open, write data.
   (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
-    (prog1
-        (with-open-file (s file
-                           :class 'file-simple-stream
-                           :direction :output :if-exists :overwrite)
-           (string= (write-string *dumb-string* s) *dumb-string*))
-      (delete-file file)))
+    (with-test-file (s file :class 'file-simple-stream :direction :output
+                       :if-exists :overwrite :if-does-not-exist :create)
+      (string= (write-string *dumb-string* s) *dumb-string*)))
   t)
 
 (deftest create-read-file-1
   ;; Via file-simple-stream objects, write and then re-read data.
   (let ((result t)
         (file (merge-pathnames #p"test-data.txt" *test-path*)))
-    (with-open-stream (s (make-instance 'file-simple-stream
-                                        :filename file
-                                        :direction :output
-                                        :if-exists :overwrite))
+    (with-test-file (s file :class 'file-simple-stream :direction :output
+                       :if-exists :overwrite :if-does-not-exist :create
+                       :delete-afterwards nil)
       (write-line *dumb-string* s)
       (setf result (and result (string= (write-string *dumb-string* s)
                                         *dumb-string*))))
-    (with-open-stream (s (make-instance 'file-simple-stream
-                                        :filename file
-                                        :direction :input
-                                        :if-does-not-exist :error))
+
+    (with-test-file (s file :class 'file-simple-stream
+                       :direction :input :if-does-not-exist :error)
       ;; Check first line
       (multiple-value-bind (string missing-newline-p)
           (read-line s)
@@ -66,7 +84,6 @@
           (read-line s)
         (setf result (and result (string= string *dumb-string*)
                           missing-newline-p))))
-    (delete-file file)
     result)
   t)
 
@@ -74,16 +91,10 @@
   ;; Read data via a mapped-file-simple-stream object.
   (let ((result t)
         (file (merge-pathnames #p"test-data.txt" *test-path*)))
-    (with-open-file (s file
-                       :class 'file-simple-stream
-                       :direction :output :if-exists :overwrite)
-       (setf result (and result (string= (write-string *dumb-string* s)
-                                         *dumb-string*))))
-    (with-open-file (s file
-                       :class 'mapped-file-simple-stream
-                       :direction :input)
-       (setf result (and result (string= (read-line s) *dumb-string*))))
-    (delete-file file)
+    (with-test-file (s file :class 'mapped-file-simple-stream
+                       :direction :input :if-does-not-exist :error
+                       :initial-content *dumb-string*)
+      (setf result (and result (string= (read-line s) *dumb-string*))))
     result)
   t)
 
@@ -102,17 +113,16 @@
   ;; (single-channel simple-stream)
   (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))
          (stream (make-instance 'file-simple-stream
-                                :filename file
-                                :direction :output))
+                                :filename file :direction :output
+                                :if-exists :overwrite
+                                :if-does-not-exist :create))
          (content (make-string (1+ (device-buffer-length stream))
                                :initial-element #\x)))
     (with-open-stream (s stream)
       (write-string content s))
-    (with-open-stream (s (make-instance 'file-simple-stream
-                                        :filename file
-                                        :direction :input))
-      (prog1 (string= content (read-line s))
-        (delete-file file))))
+    (with-test-file (s file :class 'file-simple-stream
+                       :direction :input :if-does-not-exist :error)
+      (string= content (read-line s))))
   t)
 
 (deftest write-read-large-dc-1
@@ -130,3 +140,121 @@
    (sb-bsd-sockets::connection-refused-error () t))
   t)
 
+
+(deftest file-position-1
+  ;; Test reading of file-position
+  (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+    (with-test-file (s file :class 'file-simple-stream :direction :input
+                       :initial-content *dumb-string*)
+      (file-position s)))
+  0)
+
+;;; file-position-2 fails ONLY when called with
+;;; (asdf:oos 'asdf:test-op :sb-simple-streams)
+;;; TODO: Find out why
+#+nil
+(deftest file-position-2
+  ;; Test reading of file-position
+  (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+    (with-test-file (s file :class 'file-simple-stream :direction :input
+                       :initial-content *dumb-string*)
+      (read-byte s)
+      (file-position s)))
+  1)
+
+(deftest file-position-3
+  ;; Test reading of file-position in the presence of unsaved data
+  (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+    (with-test-file (s file :class 'file-simple-stream :direction :output
+                       :if-exists :supersede :if-does-not-exist :create)
+      (write-byte 50 s)
+      (file-position s)))
+  1)
+
+(deftest file-position-4
+    ;; Test file position when opening with :if-exists :append
+    (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+      (with-test-file (s file :class 'file-simple-stream :direction :io
+                         :if-exists :append :if-does-not-exist :create
+                         :initial-content "Foo")
+        (= (file-length s) (file-position s))))
+  T)
+
+(deftest write-read-unflushed-sc-1
+  ;; Write something into a single-channel stream and read it back
+  ;; without explicitly flushing the buffer in-between
+  (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+    (with-test-file (s file :class 'file-simple-stream :direction :io
+                       :if-does-not-exist :create :if-exists :supersede)
+      (write-char #\x s)
+      (file-position s :start)
+      (read-char s)))
+  #\x)
+
+(deftest write-read-unflushed-sc-2
+  ;; Write something into a single-channel stream, try to read back too much
+  (handler-case
+   (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+     (with-test-file (s file :class 'file-simple-stream :direction :io
+                        :if-does-not-exist :create :if-exists :supersede)
+       (write-char #\x s)
+       (file-position s :start)
+       (read-char s)
+       (read-char s))
+     nil)
+    (end-of-file () t))
+  t)
+
+(deftest write-read-unflushed-sc-3
+    (let ((file (merge-pathnames #p"test-data.txt" *test-path*))
+          (result t))
+      (with-test-file (s file :class 'file-simple-stream :direction :io
+                         :if-exists :overwrite :if-does-not-exist :create
+                         :initial-content *dumb-string*)
+        (setq result (and result (char= (read-char s) (char *dumb-string* 0))))
+        (setq result (and result (= (file-position s) 1)))
+        (let ((pos (file-position s)))
+          (write-char #\x s)
+          (file-position s pos)
+          (setq result (and result (char= (read-char s) #\x)))))
+      result)
+  t)
+
+(deftest write-read-unflushed-sc-4
+    ;; Test flushing of buffers
+    (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+      (with-test-file (s file :class 'file-simple-stream :direction :io
+                         :if-exists :overwrite :if-does-not-exist :create
+                         :initial-content "Foo"
+                         :delete-afterwards nil)
+        (read-char s)                   ; Fill the buffer.
+        (file-position s :start)        ; Change existing data.
+        (write-char #\X s)
+        (file-position s :end)          ; Extend file.
+        (write-char #\X s))
+      (with-test-file (s file :class 'file-simple-stream :direction :input
+                         :if-does-not-exist :error)
+        (read-line s)))
+  "XooX"
+  T)
+
+(deftest write-read-append-sc-1
+    ;; Test writing in the middle of a stream opened in append mode
+    (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+      (with-test-file (s file :class 'file-simple-stream :direction :io
+                         :if-exists :append :if-does-not-exist :create
+                         :initial-content "Foo"
+                         :delete-afterwards nil)
+        (file-position s :start)        ; Jump to beginning.
+        (write-char #\X s)
+        (file-position s :end)          ; Extend file.
+        (write-char #\X s))
+      (with-test-file (s file :class 'file-simple-stream :direction :input
+                         :if-does-not-exist :error)
+        (read-line s)))
+  "XooX"
+  T)
+
+
+
+
diff --git a/contrib/sb-simple-streams/simple-streams.lisp b/contrib/sb-simple-streams/simple-streams.lisp
index e762c9f..47ab399 100644
--- a/contrib/sb-simple-streams/simple-streams.lisp
+++ b/contrib/sb-simple-streams/simple-streams.lisp
@@ -9,12 +9,68 @@
 (in-package "SB-SIMPLE-STREAMS")
 
 ;;;
+;;; SETUP
+;;;
+
+(defmethod shared-initialize :after ((instance simple-stream) slot-names
+				     &rest initargs &key &allow-other-keys)
+  (declare (ignore slot-names))
+  (unless (slot-boundp instance 'melded-stream)
+    (setf (slot-value instance 'melded-stream) instance)
+    (setf (slot-value instance 'melding-base) instance))
+  (unless (device-open instance initargs)
+    (device-close instance t)))
+
+;;; From the simple-streams documentation: "A generic function implies
+;;; a specialization capability that does not exist for
+;;; simple-streams; simple-stream specializations should be on
+;;; device-close."  So don't do it.
+(defmethod close ((stream simple-stream) &key abort)
+  (device-close stream abort))
+
+
+;;; This takes care of the things all device-close methods have to do,
+;;; regardless of the type of simple-stream
+(defmethod device-close :around ((stream simple-stream) abort)
+  (with-stream-class (simple-stream stream)
+    (when (any-stream-instance-flags stream :input :output)
+      (when (any-stream-instance-flags stream :output)
+	(if abort
+	    (clear-output stream)
+	    (force-output stream)))
+      (call-next-method)
+      (setf (sm input-handle stream) nil
+	    (sm output-handle stream) nil
+	    (sm j-listen stream) #'sb-kernel::closed-flame
+	    (sm j-read-char stream) #'sb-kernel::closed-flame
+	    (sm j-read-chars stream) #'sb-kernel::closed-flame
+	    (sm j-unread-char stream) #'sb-kernel::closed-flame
+	    (sm j-write-char stream) #'sb-kernel::closed-flame	;@@
+	    (sm j-write-chars stream) #'sb-kernel::closed-flame) ;@@
+      (remove-stream-instance-flags stream :input :output)
+      (sb-ext:cancel-finalization stream))))
+
+;;;
 ;;; Stream printing
 ;;;
 
+(defmethod print-object ((object simple-stream) stream)
+  (print-unreadable-object (object stream :type nil :identity nil)
+    (cond ((not (any-stream-instance-flags object :simple))
+	   (princ "Invalid " stream))
+	  ((not (any-stream-instance-flags object :input :output))
+	   (princ "Closed " stream)))
+    (format stream "~:(~A~)" (type-of object))))
+
 (defmethod print-object ((object file-simple-stream) stream)
-  (print-unreadable-object (object stream :type t :identity t)
-    (format stream "for ~S" (slot-value object 'filename))))
+  (print-unreadable-object (object stream :type nil :identity nil)
+    (with-stream-class (file-simple-stream object)
+      (cond ((not (any-stream-instance-flags object :simple))
+             (princ "Invalid " stream))
+            ((not (any-stream-instance-flags object :input :output))
+             (princ "Closed " stream)))
+      (format stream "~:(~A~) for ~S"
+	      (type-of object) (sm filename object)))))
 
 (defun make-control-table (&rest inits)
   (let ((table (make-array 32 :initial-element nil)))
@@ -51,6 +107,9 @@
 (defvar *terminal-control-in-table*
   (make-control-table #\Newline #'std-dc-newline-in-handler))
 
+(defun find-external-format (name)
+  nil)
+
 ;;;
 ;;; LOW LEVEL STUFF
 ;;;
@@ -58,8 +117,11 @@
 (defun vector-elt-width (vector)
   ;; Return octet-width of vector elements
   (etypecase vector
-    ;; missing are: bit, unsigned-byte 2, unsigned-byte 4, signed-byte 30
-    ;; [and base-char, which is treated specially]
+    ;; (simple-array fixnum (*)) not supported
+    ;; (simple-array base-char (*)) treated specially; don't call this
+    ((simple-array bit (*)) 1)
+    ((simple-array (unsigned-byte 2) (*)) 1)
+    ((simple-array (unsigned-byte 4) (*)) 1)
     ((simple-array (signed-byte 8) (*)) 1)
     ((simple-array (unsigned-byte 8) (*)) 1)
     ((simple-array (signed-byte 16) (*)) 2)
@@ -73,12 +135,7 @@
 
 (defun endian-swap-value (vector endian-swap)
   (case endian-swap
-    (:network-order (case (vector-elt-width vector)
-		      (1 0)
-		      (2 1)
-		      (4 3)
-		      (8 7)
-		      (16 15)))
+    (:network-order (1- (vector-elt-width vector)))
     (:byte-8 0)
     (:byte-16 1)
     (:byte-32 3)
@@ -86,6 +143,7 @@
     (:byte-128 15)
     (otherwise endian-swap)))
 
+
 (defun read-vector (vector stream &key (start 0) end (endian-swap :byte-8))
   (declare (type (sb-kernel:simple-unboxed-array (*)) vector)
 	   (type stream stream))
@@ -122,15 +180,11 @@
 			     (simple-array (signed-byte 8) (*))
 			     (simple-array (unsigned-byte 8) (*))))
        (error "Wrong vector type for read-vector on stream not of type simple-stream."))
+     ;; FIXME: implement blocking/non-blocking semantics here as well
      (read-sequence vector stream :start (or start 0) :end end))))
 
 #|(defun write-vector ...)|#
 
-;;; TODO: move getpagesize into sbcl/unix.lisp, where it belongs
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun getpagesize ()
-    (sb-unix::int-syscall ("getpagesize"))))
-
 (defun read-octets (stream buffer start end blocking)
   (declare (type simple-stream stream)
 	   (type (or null simple-stream-buffer) buffer)
@@ -155,8 +209,7 @@
 		    (tagbody
 		     again
 		       ;; Avoid CMUCL gengc write barrier
-		       (do ((i start (+ i ;#.(sb-unix:unix-getpagesize)
-                                        (the fixnum (getpagesize)))))
+		       (do ((i start (+ i (the fixnum (sb-posix:getpagesize)))))
 			   ((>= i end))
 			 (declare (type fixnum i))
 			 (setf (bref buffer i) 0))
@@ -170,7 +223,7 @@
 			   (incf count bytes)
 			   (incf start bytes))
 			 (cond ((null bytes)
-				(format t "~&;; UNIX-READ: errno=~D~%" errno)
+				(format *debug-io* "~&;; UNIX-READ: errno=~D~%" errno)
 				(cond ((= errno sb-unix:eintr) (go again))
 				      ((and blocking
 					    (or (= errno ;;sb-unix:eagain
@@ -187,7 +240,7 @@
         ;; Handle encapsulated stream.  FIXME: perhaps handle
         ;; sbcl-vintage ansi-stream type in read-octets too?
         (stream (read-octets fd buffer start end blocking))
-	(t (error "Don't know how to handle input handle &A" fd))))))
+	(t (error "Don't know how to handle input handle &S" fd))))))
 
 (defun write-octets (stream buffer start end blocking)
   (declare (type simple-stream stream)
@@ -232,9 +285,87 @@
 ;;; IMPLEMENTATIONS
 ;;;
 
-(defmethod device-open ((stream null-simple-stream) options)
-  (add-stream-instance-flags stream :simple :input :output)
-  stream)
+
+;;; simple-stream, dual-channel-simple-stream,
+;;; single-channel-simple-stream
+
+(defmethod device-buffer-length ((stream simple-stream))
+  4096)
+
+(defmethod device-file-position ((stream simple-stream))
+  (with-stream-class (simple-stream stream)
+    (cond ((any-stream-instance-flags stream :dual)
+	   (with-stream-class (dual-channel-simple-stream stream)
+	     (sm buffpos stream)))
+	  ((any-stream-instance-flags stream :string)
+	   (with-stream-class (string-simple-stream stream)
+	     (sm buffpos stream)))
+	  (t
+	   (with-stream-class (single-channel-simple-stream stream)
+	     (sm buffpos stream))))))
+
+
+(defmethod (setf device-file-position) (value (stream simple-stream))
+  (with-stream-class (simple-stream stream)
+    (cond ((any-stream-instance-flags stream :dual)
+	   (with-stream-class (dual-channel-simple-stream stream)
+	     (setf (sm buffpos stream) value)))
+	  ((any-stream-instance-flags stream :string)
+	   (with-stream-class (string-simple-stream stream)
+	     (setf (sm buffpos stream) value)))
+	  (t
+	   (with-stream-class (single-channel-simple-stream stream)
+	     (setf (sm buffpos stream) value))))))
+
+(defmethod device-file-length ((stream simple-stream))
+  nil)
+
+(defmethod device-read ((stream single-channel-simple-stream) buffer
+			start end blocking)
+  ;; rudi (2003-06-07): this block commented out in Paul Foley's code
+;;   (when (and (null buffer) (not (eql start end)))
+;;     (with-stream-class (single-channel-simple-stream stream)
+;;       (setq buffer (sm buffer stream))
+;;       (setq end (sm buf-len stream))))
+  (read-octets stream buffer start end blocking))
+
+(defmethod device-read ((stream dual-channel-simple-stream) buffer
+			start end blocking)
+  (when (null buffer)
+    (with-stream-class (dual-channel-simple-stream stream)
+      (setq buffer (sm buffer stream))
+      (setq end (- (sm buf-len stream) start))))
+  (read-octets stream buffer start end blocking))
+
+(defmethod device-clear-input ((stream simple-stream) buffer-only)
+  (declare (ignore buffer-only))
+  nil)
+
+(defmethod device-write ((stream single-channel-simple-stream) buffer
+			 start end blocking)
+  (when (and (null buffer) (not (eql start end)))
+    (with-stream-class (single-channel-simple-stream stream)
+      (setf buffer (sm buffer stream))
+      (setf end (sm buffpos stream))))
+  (write-octets stream buffer start end blocking))
+
+(defmethod device-write ((stream dual-channel-simple-stream) buffer
+			 start end blocking)
+  (when (and (null buffer) (not (eql start end)))
+    (with-stream-class (dual-channel-simple-stream stream)
+      (setf buffer (sm out-buffer stream))
+      (setf end (sm outpos stream))))
+  (write-octets stream buffer start end blocking))
+
+(defmethod device-clear-output ((stream simple-stream))
+  nil)
+
+
+;;; Direct-Simple-Stream and Buffer-(Input|Output)-Simple-Stream
+
+(defmethod device-file-length ((stream direct-simple-stream))
+  ;; return buffer length
+  )
 
 (defmethod device-open ((stream buffer-input-simple-stream) options)
   #| do something |#
@@ -244,13 +375,16 @@
   #| do something |#
   stream)
 
+
+;;; Definition of File-Simple-Stream and relations
+
 (defun open-file-stream (stream options)
   (let ((filename (pathname (getf options :filename)))
 	(direction (getf options :direction :input))
 	(if-exists (getf options :if-exists))
-	(if-exists-given (not (getf options :if-exists t)))
+	(if-exists-given (not (eql (getf options :if-exists t) t)))
 	(if-does-not-exist (getf options :if-does-not-exist))
-	(if-does-not-exist-given (not (getf options :if-does-not-exist t))))
+	(if-does-not-exist-given (not (eql (getf options :if-does-not-exist t) t))))
     (with-stream-class (file-simple-stream stream)
       (ecase direction
 	(:input (add-stream-instance-flags stream :input))
@@ -310,16 +444,60 @@
 		(sm buf-len stream) length)))
       (when (any-stream-instance-flags stream :output)
 	(setf (sm control-out stream) *std-control-out-table*))
-      (install-single-channel-character-strategy
-       stream (getf options :external-format :default) nil))))
+      (let ((efmt (getf options :external-format :default)))
+	(compose-encapsulating-streams stream efmt)
+	(install-single-channel-character-strategy stream efmt nil)))))
+
+(defmethod device-close ((stream file-simple-stream) abort)
+  (with-stream-class (file-simple-stream stream)
+    (cond (abort
+           ;; TODO:
+	   ;; Remove any fd-handler
+	   ;; If it's an output stream and has an original name,
+	   ;; revert the file
+	   )
+	  (t
+           ;; TODO:
+	   ;; If there's an original name and delete-original is set
+	   ;; kill the original
+	   ))
+    (if (sm input-handle stream)
+	(sb-unix:unix-close (sm input-handle stream))
+        (sb-unix:unix-close (sm output-handle stream)))
+    (setf (sm buffer stream) nil))
+  t)
+
+(defmethod device-file-position ((stream file-simple-stream))
+  (with-stream-class (file-simple-stream stream)
+    (values (sb-unix:unix-lseek (or (sm input-handle stream)
+                                    (sm output-handle stream))
+                                0
+                                sb-unix:l_incr))))
+
+(defmethod (setf device-file-position) (value (stream file-simple-stream))
+  (declare (type fixnum value))
+  (with-stream-class (file-simple-stream stream)
+    (values (sb-unix:unix-lseek (or (sm input-handle stream)
+                                    (sm output-handle stream))
+                                value
+                                (if (minusp value)
+                                    sb-unix:l_xtnd
+                                    sb-unix:l_set)))))
+
+(defmethod device-file-length ((stream file-simple-stream))
+  (with-stream-class (file-simple-stream stream)
+    (multiple-value-bind (okay dev ino mode nlink uid gid rdev size)
+	(sb-unix:unix-fstat (sm input-handle stream))
+      (declare (ignore dev ino mode nlink uid gid rdev))
+      (if okay size nil))))
 
 (defmethod device-open ((stream mapped-file-simple-stream) options)
   (with-stream-class (mapped-file-simple-stream stream)
     (when (open-file-stream stream options)
       (let* ((input (any-stream-instance-flags stream :input))
 	     (output (any-stream-instance-flags stream :output))
-	     (prot (logior (if input PROT-READ 0)
-			   (if output PROT-WRITE 0)))
+	     (prot (logior (if input sb-posix::PROT-READ 0)
+			   (if output sb-posix::PROT-WRITE 0)))
 	     (fd (or (sm input-handle stream) (sm output-handle stream))))
 	(multiple-value-bind (okay dev ino mode nlink uid gid rdev size)
 	    (sb-unix:unix-fstat fd)
@@ -335,12 +513,13 @@
 	    ;; BUF-MAX and BUF-PTR have to be the same, which means
 	    ;; number-consing every time BUF-PTR moves...
 	    ;; Probably don't have the address space available to map
-	    ;; bigger files, anyway.  Maybe DEVICE-EXTEND can adjust
-	    ;; the mapped portion of the file?
+	    ;; bigger files, anyway.
 	    (warn "Unable to memory-map entire file.")
 	    (setf size most-positive-fixnum))
 	  (let ((buffer
-		 (sb-unix:unix-mmap nil size prot MAP-SHARED fd 0)))
+		 (handler-case
+                  (sb-posix:mmap nil size prot sb-posix::MAP-SHARED fd 0)
+                  (sb-posix:syscall-error nil))))
 	    (when (null buffer)
 	      (sb-unix:unix-close fd)
 	      (sb-ext:cancel-finalization stream)
@@ -353,26 +532,62 @@
 	     stream (getf options :external-format :default) 'mapped)
 	    (sb-ext:finalize stream
 	      (lambda ()
-		(sb-unix:unix-munmap buffer size)
+		(sb-posix:munmap buffer size)
 		(format *terminal-io* "~&;;; ** unmapped ~S" buffer)))))))
     stream))
 
-(defmethod device-open ((stream string-input-simple-stream) options)
-  #| do something |#
-  stream)
+(defmethod device-close ((stream mapped-file-simple-stream) abort)
+  (with-stream-class (mapped-file-simple-stream stream)
+    (when (sm buffer stream)
+      (sb-posix:munmap (sm buffer stream) (sm buf-len stream))
+      (setf (sm buffer stream) nil))
+    (cond (abort
+	   ;; remove any FD handler
+	   ;; if it has an original name (is this possible for mapped files?)
+	   ;;   revert the file
+	   )
+	  (t
+	   ;; if there's an original name and delete-original is set (again,
+	   ;;   is this even possible?), kill the original
+	   ))
+    (sb-unix:unix-close (sm input-handle stream)))
+  t)
 
-(defmethod device-open ((stream string-output-simple-stream) options)
-  #| do something |#
-  stream)
 
-(defmethod device-open ((stream xp-simple-stream) options)
-  #| do something |#
-  stream)
+;;; Definition of Null-Simple-Stream
 
-(defmethod device-open ((stream fill-pointer-output-simple-stream) options)
-  #| do something |#
+
+(defmethod device-open ((stream null-simple-stream) options)
+  (with-stream-class (null-simple-stream stream)
+    (add-stream-instance-flags stream :simple :input :output)
+    ;;(install-single-channel-character-strategy
+    ;; stream (getf options :external-format :default) nil)
+    (setf (sm j-read-char stream) #'null-read-char
+	  (sm j-read-chars stream) #'null-read-chars
+	  (sm j-unread-char stream) #'null-unread-char
+	  (sm j-write-char stream) #'null-write-char
+	  (sm j-write-chars stream) #'null-write-chars
+	  (sm j-listen stream) #'null-listen))
   stream)
 
+
+(defmethod device-buffer-length ((stream null-simple-stream))
+  256)
+
+(defmethod device-read ((stream null-simple-stream) buffer
+			start end blocking)
+  (declare (ignore buffer start end blocking))
+  -1)
+
+(defmethod device-write ((stream null-simple-stream) buffer
+			 start end blocking)
+  (declare (ignore buffer blocking))
+  (- end start))
+
+
+;;; Socket-Simple-Stream and relatives
+
+
 (defmethod device-open ((stream socket-base-simple-stream) options)
   #| do something |#
   stream)
@@ -397,7 +612,8 @@
                             (sb-unix:unix-close fd)
                             (format *terminal-io*
                                     "~&;;; ** closed socket (fd ~D)~%" fd))))
-       ;; Now frob the stream slots.
+       ;; Now frob the stream slots.  FIXME: should we handle a
+       ;; :direction arg from output, defaulting to :input only?
        (add-stream-instance-flags stream :simple :input :output :dual)
        (unless (sm buffer stream)
          (let ((length (device-buffer-length stream)))
@@ -417,81 +633,6 @@
         stream (getf options :external-format :default)))
      stream))
 
-(defmethod device-open ((stream terminal-simple-stream) options)
-  (with-stream-class (terminal-simple-stream stream)
-    (when (getf options :input-handle)
-      (setf (sm input-handle stream) (getf options :input-handle))
-      (add-stream-instance-flags stream :simple :interactive :dual :input)
-      (unless (sm buffer stream)
-	(let ((length (device-buffer-length stream)))
-	  (setf (sm buffer stream) (make-string length)
-		(sm buf-len stream) length)))
-      (setf (sm control-in stream) *terminal-control-in-table*))
-    (when (getf options :output-handle)
-      (setf (sm output-handle stream) (getf options :output-handle))
-      (add-stream-instance-flags stream :simple :interactive :dual :output)
-      (unless (sm out-buffer stream)
-	(let ((length (device-buffer-length stream)))
-	  (setf (sm out-buffer stream) (make-string length)
-		(sm max-out-pos stream) length)))
-      (setf (sm control-out stream) *std-control-out-table*))
-    (install-dual-channel-character-strategy
-     stream (getf options :external-format :default)))
-  #| do something |#
-  stream)
-
-
-(defmethod device-close :around ((stream simple-stream) abort)
-  (with-stream-class (simple-stream stream)
-    (when (any-stream-instance-flags stream :input :output)
-      (when (any-stream-instance-flags stream :output)
-	(if abort
-	    (clear-output stream)
-	    (force-output stream)))
-      (call-next-method)
-      (setf (sm input-handle stream) nil
-	    (sm output-handle stream) nil)
-      (remove-stream-instance-flags stream :input :output)
-      (sb-ext:cancel-finalization stream))))
-
-(defmethod device-close ((stream simple-stream) abort)
-  (declare (ignore abort))
-  t)
-
-(defmethod device-close ((stream file-simple-stream) abort)
-  (with-stream-class (file-simple-stream stream)
-    (cond (abort
-	   ;; Remove any fd-handler
-	   ;; If it's an output stream and has an original name,
-	   ;; revert the file
-	   )
-	  (t
-	   ;; If there's an original name and delete-original is set
-	   ;; kill the original
-	   ))
-    (if (sm input-handle stream)
-	(sb-unix:unix-close (sm input-handle stream))
-      (sb-unix:unix-close (sm output-handle stream)))
-    (setf (sm buffer stream) nil))
-  t)
-
-(defmethod device-close ((stream mapped-file-simple-stream) abort)
-  (with-stream-class (mapped-file-simple-stream stream)
-    (when (sm buffer stream)
-      (sb-unix:unix-munmap (sm buffer stream) (sm buf-len stream))
-      (setf (sm buffer stream) nil))
-    (cond (abort
-	   ;; remove any FD handler
-	   ;; if it has an original name (is this possible for mapped files?)
-	   ;;   revert the file
-	   )
-	  (t
-	   ;; if there's an original name and delete-original is set (again,
-	   ;;   is this even possible?), kill the original
-	   ))
-    (sb-unix:unix-close (sm input-handle stream)))
-  t)
-
 (defmethod device-close ((stream socket-simple-stream) abort)
   ;; Abort argument is handled by :around method on base class
   (declare (ignore abort))
@@ -502,22 +643,9 @@
   (sb-ext:cancel-finalization stream)
   t)
 
-(defmethod device-buffer-length ((stream simple-stream))
-  4096)
-
-(defmethod device-buffer-length ((stream null-simple-stream))
-  256)
-
 
-(defmethod device-file-position ((stream simple-stream))
-  (with-stream-class (simple-stream stream)
-    ;; this may be wrong if :DUAL flag is set!
-    (sm buffpos stream)))
+;;; String-Simple-Stream and relatives
 
-(defmethod (setf device-file-position) (value (stream simple-stream))
-  (with-stream-class (simple-stream stream)
-    ;; this may be wrong if :DUAL flag is set!
-    (setf (sm buffpos stream) value)))
 
 (defmethod device-file-position ((stream string-simple-stream))
   ;; get string length (of input or output buffer?)
@@ -527,6 +655,56 @@
   ;; set string length (of input or output buffer?)
   )
 
+(defmethod device-file-length ((stream string-simple-stream))
+  ;; return string length
+  )
+
+(defmethod device-open :before ((stream string-input-simple-stream) options)
+  (with-stream-class (string-input-simple-stream stream)
+    (let ((string (getf options :string)))
+      (when (and string (null (sm buffer stream)))
+	(let ((start (getf options :start))
+	      (end (or (getf options :end) (length string))))
+	  (setf (sm buffer stream) string
+		(sm buffpos stream) start
+		(sm buffer-ptr stream) end))))
+    (install-string-input-character-strategy stream)
+    (add-stream-instance-flags stream :string :input :simple)))
+
+(defmethod device-open :before ((stream string-output-simple-stream) options)
+  (with-stream-class (string-output-simple-stream stream)
+    (unless (sm out-buffer stream)
+      (let ((string (getf options :string)))
+	(if string
+	    (setf (sm out-buffer stream) string
+		  (sm max-out-pos stream) (length string))
+	    (let ((buflen (max (device-buffer-length stream) 16)))
+	      (setf (sm out-buffer stream) (make-string buflen)
+		    (sm max-out-pos stream) buflen)))))
+    (unless (sm control-out stream)
+      (setf (sm control-out stream) *std-control-out-table*))
+    (install-string-output-character-strategy stream)
+    (add-stream-instance-flags stream :string :output :simple)))
+
+
+(defmethod device-open ((stream string-input-simple-stream) options)
+  #| do something |#
+  stream)
+
+
+(defmethod device-open ((stream string-output-simple-stream) options)
+  #| do something |#
+  stream)
+
+
+(defmethod device-open ((stream xp-simple-stream) options)
+  #| do something |#
+  stream)
+
+(defmethod device-open ((stream fill-pointer-output-simple-stream) options)
+  #| do something |#
+  stream)
+
 (defmethod device-file-position ((stream fill-pointer-output-simple-stream))
   ;; get fill pointer (of input or output buffer?)
   )
@@ -536,63 +714,55 @@
   ;; set fill pointer (of input or output buffer?)
   )
 
-(defmethod device-file-position ((stream file-simple-stream))
-  (with-stream-class (file-simple-stream stream)
-    (values (sb-unix:unix-lseek (or (sm input-handle stream)
-                                    (sm output-handle stream))
-                                0
-                                sb-unix:l_incr))))
 
-(defmethod (setf device-file-position) (value (stream file-simple-stream))
-  (declare (type fixnum value))
-  (with-stream-class (file-simple-stream stream)
-    (values (sb-unix:unix-lseek (or (sm input-handle stream)
-                                    (sm output-handle stream))
-                                value
-                                (if (minusp value)
-                                    sb-unix:l_xtnd
-                                    sb-unix:l_set)))))
+;;; Terminal-Simple-Stream
 
+(defmethod device-open ((stream terminal-simple-stream) options)
+  (with-stream-class (terminal-simple-stream stream)
+    (when (getf options :input-handle)
+      (setf (sm input-handle stream) (getf options :input-handle))
+      (add-stream-instance-flags stream :simple :interactive :dual :input)
+      (unless (sm buffer stream)
+	(let ((length (device-buffer-length stream)))
+	  (setf (sm buffer stream) (make-string length)
+		(sm buf-len stream) length)))
+      (setf (sm control-in stream) *terminal-control-in-table*))
+    (when (getf options :output-handle)
+      (setf (sm output-handle stream) (getf options :output-handle))
+      (add-stream-instance-flags stream :simple :interactive :dual :output)
+      (unless (sm out-buffer stream)
+	(let ((length (device-buffer-length stream)))
+	  (setf (sm out-buffer stream) (make-string length)
+		(sm max-out-pos stream) length)))
+      (setf (sm control-out stream) *std-control-out-table*))
+    (install-dual-channel-character-strategy
+     stream (getf options :external-format :default)))
+  ;; TODO (rudi 2003-06-08): when neither input-handle nor
+  ;; output-handle are given, close the stream again.
+  #| do something |#
+  stream)
 
-(defmethod device-file-length ((stream simple-stream))
-  nil)
+(defmethod device-read ((stream terminal-simple-stream) buffer
+                        start end blocking)
+  (let ((result (call-next-method)))
+    (if (= result -1) -2 result)))
 
-(defmethod device-file-length ((stream direct-simple-stream))
-  ;; return buffer length
+(defmethod device-clear-input ((stream terminal-simple-stream) buffer-only)
   )
 
-(defmethod device-file-length ((stream string-simple-stream))
-  ;; return string length
-  )
+(defmethod device-close ((stream simple-stream) abort)
+  (declare (ignore abort))
+  t)
+
+
+
+
+
 
-(defmethod device-file-length ((stream file-simple-stream))
-  (with-stream-class (file-simple-stream stream)
-    (multiple-value-bind (okay dev ino mode nlink uid gid rdev size)
-	(sb-unix:unix-fstat (sm input-handle stream))
-      (declare (ignore dev ino mode nlink uid gid rdev))
-      (if okay size nil))))
 
 
-(defmethod device-read ((stream single-channel-simple-stream) buffer
-			start end blocking)
-;;  (when (and (null buffer) (not (eql start end)))
-;;    (with-stream-class (single-channel-simple-stream stream)
-;;      (setq buffer (sm buffer stream))
-;;      (setq end (sm buf-len stream))))
-  (read-octets stream buffer start end blocking))
 
-(defmethod device-read ((stream dual-channel-simple-stream) buffer
-			start end blocking)
-  (when (null buffer)
-    (with-stream-class (dual-channel-simple-stream stream)
-      (setq buffer (sm buffer stream))
-      (setq end (- (sm buf-len stream) start))))
-  (read-octets stream buffer start end blocking))
 
-(defmethod device-read ((stream null-simple-stream) buffer
-			start end blocking)
-  (declare (ignore buffer start end blocking))
-  -1)
 
 (defmethod device-read ((stream terminal-simple-stream) buffer
 			start end blocking)
@@ -600,34 +770,11 @@
     (if (= result -1) -2 result)))
 
 
-(defmethod device-clear-input ((stream simple-stream) buffer-only)
-  (declare (ignore buffer-only))
-  nil)
 
 (defmethod device-clear-input ((stream terminal-simple-stream) buffer-only)
   )
 
 
-(defmethod device-write ((stream single-channel-simple-stream) buffer
-			 start end blocking)
-  (when (and (null buffer) (not (eql start end)))
-    (with-stream-class (single-channel-simple-stream stream)
-      (setf buffer (sm buffer stream))
-      (setf end (sm buffpos stream))))
-  (write-octets stream buffer start end blocking))
-
-(defmethod device-write ((stream dual-channel-simple-stream) buffer
-			 start end blocking)
-  (when (and (null buffer) (not (eql start end)))
-    (with-stream-class (dual-channel-simple-stream stream)
-      (setf buffer (sm out-buffer stream))
-      (setf end (sm outpos stream))))
-  (write-octets stream buffer start end blocking))
-
-(defmethod device-write ((stream null-simple-stream) buffer
-			 start end blocking)
-  (declare (ignore buffer blocking))
-  (- end start))
 
 (defmethod device-write ((stream socket-base-simple-stream) buffer
 			 start end blocking)
@@ -635,30 +782,10 @@
   (call-next-method))
 
 
-(defmethod device-clear-output ((stream simple-stream))
-  nil)
 
 
-(defmethod device-extend ((stream direct-simple-stream) need action)
-  (declare (ignore need action))
-  nil)
 
-(defmethod device-extend ((stream string-input-simple-stream) need action)
-  (declare (ignore need action))
-  nil)
 
-(defmethod device-extend ((stream string-output-simple-stream) need action)
-  ;; @@3
-  )
-
-(defmethod device-extend ((stream fill-pointer-output-simple-stream)
-			  need action)
-  ;; @@4
-  )
-
-(defmethod device-extend ((stream mapped-file-simple-stream) need action)
-  (declare (ignore need action))
-  nil)
 
 
 ;; device-finish-record apparently has no methods defined
diff --git a/contrib/sb-simple-streams/strategy.lisp b/contrib/sb-simple-streams/strategy.lisp
index ea3bfd9..2538f74 100644
--- a/contrib/sb-simple-streams/strategy.lisp
+++ b/contrib/sb-simple-streams/strategy.lisp
@@ -9,41 +9,70 @@
 (in-package "SB-SIMPLE-STREAMS")
 
 
-(defun refill-buffer (stream blocking)
-  (with-stream-class (simple-stream stream)
+
+(defun sc-refill-buffer (stream blocking)
+  (with-stream-class (single-channel-simple-stream stream)
+    (when (any-stream-instance-flags stream :dirty)
+      ;; FIXME: Implement flush-buffer failure protocol instead of
+      ;; blocking here
+      (sc-flush-buffer stream t))
     (let* ((unread (sm last-char-read-size stream))
-	   (buffer (sm buffer stream)))
+           (buffer (sm buffer stream)))
       (unless (zerop unread)
-        ;; Keep last read character at beginning of buffer
-	(buffer-copy buffer (- (sm buffer-ptr stream) unread) buffer 0 unread))
+        (buffer-copy buffer (- (sm buffer-ptr stream) unread) buffer 0 unread))
       (let ((bytes (device-read stream nil unread nil blocking)))
-	(declare (type fixnum bytes))
-	(setf (sm buffpos stream) unread
-	      (sm buffer-ptr stream) (if (plusp bytes)
-					 (+ bytes unread)
-					 unread))
-	bytes))))
+        (declare (type fixnum bytes))
+        (setf (sm buffpos stream) unread
+              (sm buffer-ptr stream) (if (plusp bytes)
+                                         (+ bytes unread)
+                                         unread))
+        bytes))))
+
 
 (defun sc-flush-buffer (stream blocking)
   (with-stream-class (single-channel-simple-stream stream)
     (let ((ptr 0)
 	  (bytes (sm buffpos stream)))
       (declare (type fixnum ptr bytes))
+      ;; Seek to the left before flushing buffer -- the user could
+      ;; have set the file-position, and scribbled something in the
+      ;; data that was read from the file.
+      (when (> (sm buffer-ptr stream) 0)
+        (setf (device-file-position stream)
+              (- (device-file-position stream) (sm buffer-ptr stream))))
       (loop
-	(when (>= ptr bytes) (setf (sm buffpos stream) 0) (return))
+	(when (>= ptr bytes)
+          (setf (sm buffpos stream) 0
+                (sm buffer-ptr stream) 0)
+          (remove-stream-instance-flags stream :dirty)
+          (return 0))
 	(let ((bytes-written (device-write stream nil ptr nil blocking)))
 	  (declare (fixnum bytes-written))
 	  (when (minusp bytes-written)
 	    (error "DEVICE-WRITE error."))
 	  (incf ptr bytes-written))))))
 
+(defun dc-refill-buffer (stream blocking)
+  (with-stream-class (dual-channel-simple-stream stream)
+    (let* ((unread (sm last-char-read-size stream))
+           (buffer (sm buffer stream)))
+      (unless (zerop unread)
+        (buffer-copy buffer (- (sm buffer-ptr stream) unread) buffer 0 unread))
+      (let ((bytes (device-read stream nil unread nil blocking)))
+        (declare (type fixnum bytes))
+        (setf (sm buffpos stream) unread
+              (sm buffer-ptr stream) (if (plusp bytes)
+                                         (+ bytes unread)
+                                         unread))
+        bytes))))
+
 (defun dc-flush-buffer (stream blocking)
   (with-stream-class (dual-channel-simple-stream stream)
     (let ((ptr 0)
 	  (bytes (sm outpos stream)))
       (declare (type fixnum ptr bytes))
       (loop
-	(when (>= ptr bytes) (setf (sm outpos stream) 0) (return))
+	(when (>= ptr bytes) (setf (sm outpos stream) 0) (return 0))
 	(let ((bytes-written (device-write stream nil ptr nil blocking)))
 	  (declare (fixnum bytes-written))
 	  (when (minusp bytes-written)
@@ -65,7 +94,7 @@
 		     (progn
 		       (setf (sm buffpos stream) (1+ ptr))
 		       (bref buffer ptr))
-		     (let ((bytes (refill-buffer stream blocking)))
+		     (let ((bytes (sc-refill-buffer stream blocking)))
 		       (declare (type fixnum bytes))
 		       (unless (minusp bytes)
 			 (let ((ptr (sm buffpos stream)))
@@ -120,7 +149,7 @@
 	   (optimize (speed 3) (space 2) (safety 0) (debug 0)))
   (with-stream-class (single-channel-simple-stream stream)
     (setf (sm last-char-read-size stream) 0)
-    ;; Should arrange for the last character to be unreadable
+    ;; FIXME: Should arrange for the last character to be unreadable
     (do ((buffer (sm buffer stream))
 	 (ptr (sm buffpos stream))
 	 (max (sm buffer-ptr stream))
@@ -132,7 +161,7 @@
 		       (prog1
 			   (bref buffer ptr)
 			 (incf ptr))
-		       (let ((bytes (refill-buffer stream blocking)))
+		       (let ((bytes (sc-refill-buffer stream blocking)))
 			 (declare (type fixnum bytes))
 			 (setf ptr (sm buffpos stream)
 			       max (sm buffer-ptr stream))
@@ -162,7 +191,7 @@
 	   (type fixnum start end)
 	   (type boolean blocking)
 	   (optimize (speed 3) (space 2) (safety 0) (debug 0)))
-  ;; TODO: what about the blocking parameter?
+  (declare (ignore blocking))           ; everything is in the buffer
   (with-stream-class (single-channel-simple-stream stream)
     (do ((buffer (sm buffer stream))
 	 (ptr (sm buffpos stream))
@@ -220,12 +249,11 @@
 		 (funcall (the (or symbol function) (svref ctrl code))
 			  stream character))
 	(return-from sc-write-char character))
-      ;; FIXME: Shouldn't this be buf-len, not buffer-ptr?
-      (unless (< ptr (sm buffer-ptr stream))
-        (sc-flush-buffer stream t)
-        (setf ptr (sm buffpos stream)))
+      (when (>= ptr (sm buf-len stream))
+        (setf ptr (sc-flush-buffer stream t)))
       (setf (bref buffer ptr) code)
-      (setf (sm buffpos stream) (1+ ptr))))
+      (setf (sm buffpos stream) (1+ ptr))
+      (add-stream-instance-flags stream :dirty)))
   character)
 
 (declaim (ftype j-write-chars-fn sc-write-chars))
@@ -233,18 +261,21 @@
   (with-stream-class (single-channel-simple-stream stream)
     (do ((buffer (sm buffer stream))
 	 (ptr (sm buffpos stream))
-         ;; xxx buffer-ptr or buf-len?  TODO: look them up in the
-         ;; docs; was: buffer-ptr, but it's initialized to 0 in
-         ;; (device-open file-simple-stream); buf-len seems to work(tm)
-	 (max #+nil(sm buffer-ptr stream) ;; or buf-len?
-              (sm buf-len stream))
+	 (max (sm buf-len stream))
 	 (ctrl (sm control-out stream))
 	 (posn start (1+ posn))
 	 (count 0 (1+ count)))
-	((>= posn end) (setf (sm buffpos stream) ptr) count)
+	((>= posn end)
+         (setf (sm buffpos stream) ptr)
+         (add-stream-instance-flags stream :dirty)
+         count)
       (declare (type fixnum ptr max posn count))
       (let* ((char (char string posn))
 	     (code (char-code char)))
+        ;; FIXME: Can functions in the control-out table side-effect
+        ;; the stream?  Section 9.0 prohibits this only for control-in
+        ;; functions.  If they can, update (sm buffpos stream) here,
+        ;; like around the call to sc-flush-buffer below
 	(unless (and (< code 32) ctrl (svref ctrl code)
 		     (funcall (the (or symbol function) (svref ctrl code))
 			      stream char))
@@ -267,6 +298,23 @@
 	  (-3 t)
 	  (t (error "DEVICE-READ error."))))))
 
+;;; SC-READ-BYTE doesn't actually live in a strategy slot
+(defun sc-read-byte (stream eof-error-p eof-value blocking)
+  (with-stream-class (single-channel-simple-stream stream)
+    ;; @@1
+    (let ((ptr (sm buffpos stream)))
+      (when (>= ptr (sm buffer-ptr stream))
+        (let ((bytes (device-read stream nil 0 nil blocking)))
+          (declare (type fixnum bytes))
+          (if (plusp bytes)
+              (setf (sm buffer-ptr stream) bytes
+                    ptr 0)
+              (return-from sc-read-byte
+                (sb-impl::eof-or-lose stream eof-error-p eof-value)))))
+      (setf (sm buffpos stream) (1+ ptr))
+      (setf (sm last-char-read-size stream) 0)
+      (bref (sm buffer stream) ptr))))
+
 ;;;
 ;;; DUAL-CHANNEL STRATEGY FUNCTIONS
 ;;;
@@ -282,7 +330,7 @@
 		     (progn
 		       (setf (sm buffpos stream) (1+ ptr))
 		       (bref buffer ptr))
-		     (let ((bytes (refill-buffer stream blocking)))
+		     (let ((bytes (dc-refill-buffer stream blocking)))
 		       (declare (type fixnum bytes))
 		       (unless (minusp bytes)
 			 (let ((ptr (sm buffpos stream)))
@@ -327,7 +375,7 @@
 		       (prog1
 			   (bref buffer ptr)
 			 (incf ptr))
-		       (let ((bytes (refill-buffer stream blocking)))
+		       (let ((bytes (dc-refill-buffer stream blocking)))
 			 (declare (type fixnum bytes))
 			 (setf ptr (sm buffpos stream)
 			       max (sm buffer-ptr stream))
@@ -365,22 +413,20 @@
 
 (declaim (ftype j-write-char-fn dc-write-char))
 (defun dc-write-char (character stream)
-  (with-stream-class (dual-channel-simple-stream stream)
-    (let* ((buffer (sm out-buffer stream))
-	   (ptr (sm outpos stream))
-	   (code (char-code character))
-	   (ctrl (sm control-out stream)))
-      (when (and (< code 32) ctrl (svref ctrl code)
-		 (funcall (the (or symbol function) (svref ctrl code))
-			  stream character))
-	(return-from dc-write-char character))
-      (unless (< ptr (sm max-out-pos stream))
-        (dc-flush-buffer stream t)
-        (setf ptr (sm outpos stream)))
-      (progn
+  (when character
+    (with-stream-class (dual-channel-simple-stream stream)
+      (let* ((buffer (sm out-buffer stream))
+             (ptr (sm outpos stream))
+             (code (char-code character))
+             (ctrl (sm control-out stream)))
+        (when (and (< code 32) ctrl (svref ctrl code)
+                   (funcall (the (or symbol function) (svref ctrl code))
+                            stream character))
+          (return-from dc-write-char character))
+        (when (>= ptr (sm max-out-pos stream))
+          (setq ptr (dc-flush-buffer stream t)))
         (setf (bref buffer ptr) code)
-        (setf (sm outpos stream) (1+ ptr))
-        )))
+        (setf (sm outpos stream) (1+ ptr)))))
   character)
 
 (declaim (ftype j-write-chars-fn dc-write-chars))
@@ -417,6 +463,22 @@
 	  (-3 t)
 	  (t (error "DEVICE-READ error."))))))
 
+;;; DC-READ-BYTE doesn't actually live in a strategy slot
+(defun dc-read-byte (stream eof-error-p eof-value blocking)
+  (with-stream-class (dual-channel-simple-stream stream)
+    (let ((ptr (sm buffpos stream)))
+      (when (>= ptr (sm buffer-ptr stream))
+        (let ((bytes (device-read stream nil 0 nil blocking)))
+          (declare (type fixnum bytes))
+          (if (plusp bytes)
+              (setf (sm buffer-ptr stream) bytes
+                    ptr 0)
+              (return-from dc-read-byte
+                (sb-impl::eof-or-lose stream eof-error-p eof-value)))))
+      (setf (sm buffpos stream) (1+ ptr))
+      (setf (sm last-char-read-size stream) 0)
+      (bref (sm buffer stream) ptr))))
+
 ;;;
 ;;; STRING STRATEGY FUNCTIONS
 ;;;
@@ -447,6 +509,7 @@
 (declaim (ftype j-read-char-fn composing-crlf-read-char))
 (defun composing-crlf-read-char (stream eof-error-p eof-value blocking)
   ;; TODO: what about the eof-error-p parameter?
+  (declare (ignore eof-error-p eof-value))
   (with-stream-class (simple-stream stream)
     (let* ((melded-stream (sm melded-stream stream))
 	   (char (funcall-stm-handler j-read-char melded-stream nil stream
@@ -479,45 +542,110 @@
     (funcall-stm-handler j-unread-char (sm melded-stream stream) nil)))
 
 ;;;
+;;; Functions to install the strategy functions in the appropriate slots
 ;;;
-;;;
+
+(defun %find-topmost-stream (stream)
+  ;; N.B.: the topmost stream in the chain of encapsulations is actually
+  ;; the bottommost in the "melding" chain
+  (with-stream-class (simple-stream)
+    (loop
+      (when (eq (sm melded-stream stream) (sm melding-base stream))
+	(return stream))
+      (setq stream (sm melded-stream stream)))))
 
 (defun install-single-channel-character-strategy (stream external-format
 							 access)
-  (declare (ignore external-format))
-  ;; ACCESS is usually NIL
-  ;; May be "undocumented" values: stream::buffer, stream::mapped
-  ;;   to install strategies suitable for direct buffer streams
-  ;;   (i.e., ones that call DEVICE-EXTEND instead of DEVICE-READ)
-  ;; (Avoids checking "mode" flags by installing special strategy)
-  (with-stream-class (single-channel-simple-stream stream)
-    (if (or (eq access 'buffer) (eq access 'mapped))
-	(setf (sm j-read-char stream) #'sc-read-char--buffer
-	      (sm j-read-chars stream) #'sc-read-chars--buffer
-	      (sm j-unread-char stream) #'sc-unread-char
-	      (sm j-write-char stream) #'sc-write-char
-	      (sm j-write-chars stream) #'sc-write-chars
-	      (sm j-listen stream) #'sc-listen)
-	(setf (sm j-read-char stream) #'sc-read-char
-	      (sm j-read-chars stream) #'sc-read-chars
-	      (sm j-unread-char stream) #'sc-unread-char
-	      (sm j-write-char stream) #'sc-write-char
-	      (sm j-write-chars stream) #'sc-write-chars
-	      (sm j-listen stream) #'sc-listen)))
+  (find-external-format external-format)
+  (let ((stream (%find-topmost-stream stream)))
+    ;; ACCESS is usually NIL
+    ;; May be "undocumented" values: stream::buffer, stream::mapped
+    ;;   to install strategies suitable for direct buffer streams
+    ;;   (i.e., ones that call DEVICE-EXTEND instead of DEVICE-READ)
+    ;; (Avoids checking "mode" flags by installing special strategy)
+    (with-stream-class (single-channel-simple-stream stream)
+      (if (or (eq access 'buffer) (eq access 'mapped))
+          (setf (sm j-read-char stream) #'sc-read-char--buffer
+                (sm j-read-chars stream) #'sc-read-chars--buffer
+                (sm j-unread-char stream) #'sc-unread-char
+                (sm j-write-char stream) #'sc-write-char
+                (sm j-write-chars stream) #'sc-write-chars
+                (sm j-listen stream) #'sc-listen)
+          (setf (sm j-read-char stream) #'sc-read-char
+                (sm j-read-chars stream) #'sc-read-chars
+                (sm j-unread-char stream) #'sc-unread-char
+                (sm j-write-char stream) #'sc-write-char
+                (sm j-write-chars stream) #'sc-write-chars
+                (sm j-listen stream) #'sc-listen))))
   stream)
 
 (defun install-dual-channel-character-strategy (stream external-format)
-  (declare (ignore external-format))
-  (with-stream-class (dual-channel-simple-stream stream)
-    (setf (sm j-read-char stream) #'dc-read-char
-	  (sm j-read-chars stream) #'dc-read-chars
-	  (sm j-unread-char stream) #'dc-unread-char
-	  (sm j-write-char stream) #'dc-write-char
-	  (sm j-write-chars stream) #'dc-write-chars
-	  (sm j-listen stream) #'dc-listen))
+  (find-external-format external-format)
+  (let ((stream (%find-topmost-stream stream)))
+    (with-stream-class (dual-channel-simple-stream stream)
+      (setf (sm j-read-char stream) #'dc-read-char
+            (sm j-read-chars stream) #'dc-read-chars
+            (sm j-unread-char stream) #'dc-unread-char
+            (sm j-write-char stream) #'dc-write-char
+            (sm j-write-chars stream) #'dc-write-chars
+            (sm j-listen stream) #'dc-listen)))
   stream)
 
-(defun install-string-character-strategy (stream)
-  (with-stream-class (string-simple-stream stream)
-    (setf (sm j-read-char stream) #'string-read-char))
+(defun install-string-input-character-strategy (stream)
+  #| implement me |#
+  (let ((stream (%find-topmost-stream stream)))
+    (with-stream-class (simple-stream stream)
+      (setf (sm j-read-char stream) #'string-read-char)))
   stream)
+
+(defun install-string-output-character-strategy (stream)
+  #| implement me |#
+  stream)
+
+(defun compose-encapsulating-streams (stream external-format)
+  (when (consp external-format)
+    (with-stream-class (simple-stream)
+      (dolist (fmt (butlast external-format))
+	(let ((encap (make-instance 'composing-stream :composing-format fmt)))
+	  (setf (sm melding-base encap) stream)
+	  (setf (sm melded-stream encap) (sm melded-stream stream))
+	  (setf (sm melded-stream stream) encap)
+	  (rotatef (sm j-listen encap) (sm j-listen stream))
+	  (rotatef (sm j-read-char encap) (sm j-read-char stream))
+	  (rotatef (sm j-read-chars encap) (sm j-read-chars stream))
+	  (rotatef (sm j-unread-char encap) (sm j-unread-char stream))
+	  (rotatef (sm j-write-char encap) (sm j-write-char stream))
+	  (rotatef (sm j-write-chars encap) (sm j-write-chars stream)))))))
+
+;;;
+;;; NULL STRATEGY FUNCTIONS
+;;;
+
+(declaim (ftype j-read-char-fn null-read-char))
+(defun null-read-char (stream eof-error-p eof-value blocking)
+  (declare (ignore blocking))
+  (sb-impl::eof-or-lose stream eof-error-p eof-value))
+
+(declaim (ftype j-read-chars-fn null-read-chars))
+(defun null-read-chars (stream string search start end blocking)
+  (declare (ignore stream string search start end blocking))
+  (values 0 :eof))
+
+(declaim (ftype j-unread-char-fn null-unread-char))
+(defun null-unread-char (stream relaxed)
+  (declare (ignore stream relaxed)))
+
+(declaim (ftype j-write-char-fn null-write-char))
+(defun null-write-char (character stream)
+  (declare (ignore stream))
+  character)
+
+(declaim (ftype j-write-chars-fn null-write-chars))
+(defun null-write-chars (string stream start end)
+  (declare (ignore string stream))
+  (- end start))
+
+(declaim (ftype j-listen-fn null-listen))
+(defun null-listen (stream)
+  (declare (ignore stream))
+  nil)
diff --git a/contrib/sb-simple-streams/unix.lisp b/contrib/sb-simple-streams/unix.lisp
deleted file mode 100644
index f75d7c5..0000000
--- a/contrib/sb-simple-streams/unix.lisp
+++ /dev/null
@@ -1,59 +0,0 @@
-;;; -*- lisp -*-
-
-;;; This code is in the public domain.
-
-;;; The cmucl implementation of simple-streams was done by Paul Foley,
-;;; who placed the code in the public domain.  Sbcl port by Rudi
-;;; Schlatte.
-
-;;; TODO (Rudi 2003-05-12): The contents of this file, along with
-;;; constants.lisp, should presumably end up somewhere else, either in
-;;; sbcl itself or in sb-posix.
-
-(in-package "SB-UNIX")
-
-
-(export '(prot-read prot-write prot-exec prot-none
-          map-shared map-private map-fixed
-          unix-mmap unix-munmap
-          unix-mlock unix-munlock))
-
-
-(defun unix-mmap (addr length prot flags fd offset)
-  (declare (type (or null system-area-pointer) addr)
-           (type (unsigned-byte 32) length)
-           (type (integer 1 7) prot)
-           (type (unsigned-byte 32) flags)
-           (type (or null unix-fd) fd)
-           (type (signed-byte 32) offset))
-  (let ((result (alien-funcall (extern-alien "mmap"
-                                             (function system-area-pointer
-                                                       system-area-pointer
-                                                       size-t int int int
-                                                       off-t))
-                               (or addr (sb-sys:int-sap 0)) length prot flags
-                               (or fd -1) offset)))
-    ;; FIXME (Rudi 2003-05-12) : here, we assume that a sap is 32
-    ;; bits.  Revisit during the 64-bit port.  #XFFFFFFFF is (void
-    ;; *)-1, which is the charming return value of mmap on failure.
-    (if (= (sb-sys:sap-int result) #XFFFFFFFF)
-        (values nil (get-errno))
-        result)))
-
-(defun unix-munmap (start length)
-  (declare (type system-area-pointer start)
-           (type (unsigned-byte 32) length))
-  (void-syscall ("munmap" system-area-pointer size-t) start length))
-
-(defun unix-mlock (addr length)
-  (declare (type system-area-pointer addr)
-	   (type (unsigned-byte 32) length))
-  (void-syscall ("mlock" system-area-pointer size-t) addr length))
-
-(defun unix-munlock (addr length)
-  (declare (type system-area-pointer addr)
-	   (type (unsigned-byte 32) length))
-  (void-syscall ("munlock" system-area-pointer size-t) addr length))
-
-
-