diff --git a/code/class.lisp b/code/class.lisp
index 9b2223c3728764e9df1500589d9bf458298f7d05..b041bc19eef41dd1b0557324f1f45abd0ddc920d 100644
--- a/code/class.lisp
+++ b/code/class.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/class.lisp,v 1.39 1998/03/21 08:11:50 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/class.lisp,v 1.40 1998/05/04 01:27:10 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -763,7 +763,10 @@
 	  (null :translation (member nil)
 		:inherits (list sequence mutable-sequence mutable-collection
 			   generic-sequence collection symbol)
-		:direct-superclasses (list symbol)))))
+		:direct-superclasses (list symbol))
+
+	  (stream :hierarchical nil :state :read-only
+		  :inherits (instance t)))))
 
 ;;; See also type-init.lisp where we finish setting up the translations for
 ;;; built-in types.
@@ -804,6 +807,24 @@
 	   (find-layout name 0 inherit-layouts inheritance-depth)
 	   :invalidate nil))))))
 
+;;; Define temporary PCL standard-classes; these will be setup
+;;; correctly and the lisp layout replaced by a PCL wrapper after PCL
+;;; is loaded and the class defined.
+(cold-load-init
+  (dolist (x '((fundamental-stream (t instance stream))))
+    (let* ((name (first x))
+	   (inherits (second x))
+	   (class (lisp::make-standard-class :name name))
+	   (class-cell (lisp::find-class-cell name)))
+      (setf (lisp::class-cell-class class-cell) class)
+      (setf (info type class name) class-cell)
+      (setf (info type kind name) :instance)
+      (let ((inherit-layouts
+	     (map 'vector #'(lambda (x)
+			      (lisp::class-layout (lisp:find-class x)))
+		  inherits)))
+	(lisp::register-layout (lisp::find-layout name 0 inherit-layouts -1)
+			       :invalidate nil)))))
 
 ;;; Now that we have set up the class heterarchy, seal the sealed classes.
 ;;; This must be done after the subclasses have been set up.
diff --git a/code/defstruct.lisp b/code/defstruct.lisp
index 69ac4021f446112af4877021fca4849c30a63e1f..d42fa325df1b9dd1aa255baf97b90acbaf7b6790 100644
--- a/code/defstruct.lisp
+++ b/code/defstruct.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.62 1998/04/20 11:32:50 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.63 1998/05/04 01:27:11 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1304,7 +1304,11 @@
 				#'(lambda (x) (typep x (find-class class))))
 			    (fdefinition constructor)))
     (setf (class-direct-superclasses class)
-	  (list (layout-class (svref inherits (1- (length inherits))))))
+	  (if (eq (dd-name info) 'lisp-stream)
+	      ;; Hack to add stream as a superclass mixin to lisp-streams.
+	      (list (layout-class (svref inherits (1- (length inherits))))
+		    (layout-class (svref inherits (- (length inherits) 2))))
+	      (list (layout-class (svref inherits (1- (length inherits)))))))
     (let ((new-layout (make-layout :class class
 				   :inherits inherits
 				   :inheritance-depth (length inherits)
@@ -1475,8 +1479,11 @@
 	      (compiler-layout-or-lose (first include))
 	      (class-layout (find-class (or (first superclass-opt)
 					    'structure-object))))))
-    (concatenate 'simple-vector (layout-inherits super) (vector super))))
-
+    (if (eq (dd-name info) 'lisp-stream)
+	;; Hack to added the stream class as a mixin for lisp-streams.
+	(concatenate 'simple-vector (layout-inherits super)
+		     (vector super (class-layout (find-class 'stream))))
+	(concatenate 'simple-vector (layout-inherits super) (vector super)))))
 
 ;;; %COMPILER-ONLY-DEFSTRUCT  --  Internal
 ;;;
diff --git a/code/exports.lisp b/code/exports.lisp
index de5b4e14d6cdd91270300619d16402da32b0b9e3..f04c16c651ab358e263d0900ac937528df549ae4 100644
--- a/code/exports.lisp
+++ b/code/exports.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.152 1998/05/01 01:02:54 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.153 1998/05/04 01:27:12 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -989,18 +989,35 @@
 	     "*DEFAULT-PACKAGE-USE-LIST*" "*GC-RUN-TIME*"
 	     "CONNECT-TO-UNIX-SOCKET"
 	     "DEFINE-HASH-TABLE-TEST"
-                          "DO-HASH"
-                          "*EFFICIENCY-NOTE-LIMIT*"
-                          "*ERROR-PRINT-LINES*"
-                          "CREATE-UNIX-SOCKET"
-                          "*INLINE-EXPANSION-LIMIT*"
-                          "INSTANCE"
-                          "*EFFICIENCY-NOTE-COST-THRESHOLD*"
-                          "*USE-IMPLEMENTATION-TYPES*"
-			  "*BYTE-COMPILE-TOP-LEVEL*"
-			  "*BYTE-COMPILE-DEFAULT*"
-			  "PURIFY" "MAP-APROPOS"
- 			  "*BATCH-MODE*"))
+
+	     "DO-HASH"
+	     "*EFFICIENCY-NOTE-LIMIT*"
+	     "*ERROR-PRINT-LINES*"
+	     "CREATE-UNIX-SOCKET"
+	     "*INLINE-EXPANSION-LIMIT*"
+	     "INSTANCE"
+	     "*EFFICIENCY-NOTE-COST-THRESHOLD*"
+	     "*USE-IMPLEMENTATION-TYPES*"
+	     "*BYTE-COMPILE-TOP-LEVEL*"
+	     "*BYTE-COMPILE-DEFAULT*"
+	     "PURIFY" "MAP-APROPOS"
+	     "*BATCH-MODE*"
+	     
+	     ;; Gray streams extension.
+	     "FUNDAMENTAL-BINARY-STREAM" "FUNDAMENTAL-BINARY-INPUT-STREAM"
+	     "FUNDAMENTAL-BINARY-OUTPUT-STREAM" "FUNDAMENTAL-CHARACTER-STREAM"
+	     "FUNDAMENTAL-CHARACTER-INPUT-STREAM"
+	     "FUNDAMENTAL-CHARACTER-OUTPUT-STREAM"
+	     "FUNDAMENTAL-INPUT-STREAM" "FUNDAMENTAL-OUTPUT-STREAM"
+	     "FUNDAMENTAL-STREAM"
+	     "STREAM-ADVANCE-TO-COLUMN" "STREAM-CLEAR-INPUT" 
+	     "STREAM-CLEAR-OUTPUT" "STREAM-FINISH-OUTPUT" "STREAM-FORCE-OUTPUT"
+	     "STREAM-FRESH-LINE" "STREAM-LINE-COLUMN" "STREAM-LINE-LENGTH"
+	     "STREAM-LISTEN" "STREAM-PEEK-CHAR" "STREAM-READ-BYTE"
+	     "STREAM-READ-CHAR" "STREAM-READ-CHAR-NO-HANG" "STREAM-READ-LINE"
+	     "STREAM-START-LINE-P" "STREAM-TERPRI" "STREAM-UNREAD-CHAR"
+	     "STREAM-WRITE-BYTE" "STREAM-WRITE-CHAR" "STREAM-WRITE-STRING"))
+
 (defpackage "LOOP")
 (dolist
     (name
@@ -1240,11 +1257,12 @@
              "DEFAULT-INTERRUPT" "DEFENUMERATION" "DEFOPERATOR" "DEFRECORD"
              "DEPORT-BOOLEAN" "DEPORT-INTEGER" "DOUBLE-FLOAT-RADIX"
              "ENABLE-INTERRUPT" "ENUMERATION" "FD-STREAM" "FD-STREAM-FD"
-             "FD-STREAM-P" "FIND-IF-IN-CLOSURE"
-             "FOREIGN-SYMBOL-ADDRESS" "GET-PAGE-SIZE" "GET-SYSTEM-INFO"
+             "FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS"
+	     "GET-PAGE-SIZE" "GET-SYSTEM-INFO"
 	     "IGNORE-INTERRUPT"
-             "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT" "LONG-FLOAT-RADIX"
-             "LONG-WORDS" "MACRO" "MAKE-CT-A-VAL" "MAKE-FD-STREAM"
+             "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT"
+	     "LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS"
+	     "MACRO" "MAKE-CT-A-VAL" "MAKE-FD-STREAM"
              "MAKE-INDENTING-STREAM" "MAKE-OBJECT-SET" "MAP-PORT" "MAP-XWINDOW"
              "NATURALIZE-BOOLEAN" "NATURALIZE-INTEGER" "NULL-TERMINATED-STRING"
              "OBJECT-SET-OPERATION" "OUTPUT-RAW-BYTES" "PARSE-BODY"
diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp
index 96f48c81d3edb943228f19eb885e123459586725..74a6d58fd6157a4905b102f0136b00e5b13342c3 100644
--- a/code/fd-stream.lisp
+++ b/code/fd-stream.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.42 1998/01/04 22:46:41 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.43 1998/05/04 01:27:13 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -61,7 +61,7 @@
 (defstruct (fd-stream
 	    (:print-function %print-fd-stream)
 	    (:constructor %make-fd-stream)
-	    (:include stream
+	    (:include lisp-stream
 		      (misc #'fd-stream-misc-routine)))
 
   (name nil)		      ; The name of this stream
@@ -858,7 +858,7 @@ non-server method is also significantly more efficient for large reads.
 	(when (eql size 1)
 	  (setf (fd-stream-n-bin stream) #'fd-stream-read-n-bytes)
 	  (when buffer-p
-	    (setf (stream-in-buffer stream)
+	    (setf (lisp-stream-in-buffer stream)
 		  (make-array in-buffer-length
 			      :element-type '(unsigned-byte 8)))))
 	(setf input-size size)
diff --git a/code/filesys.lisp b/code/filesys.lisp
index 1f07131d2333fd81c603c1e84184ae68d7d7f84c..990496a609e9b8852858a967337c463ffea046c8 100644
--- a/code/filesys.lisp
+++ b/code/filesys.lisp
@@ -6,7 +6,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.48 1998/04/24 13:10:15 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.49 1998/05/04 01:27:13 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -847,7 +847,7 @@
    non-nil, then Unix dot files are included too (as ls -a).  When :vervose
    is supplied and non-nil, then a long listing of miscellaneous
    information is output one file per line."
-  (let ((*standard-output* (out-synonym-of stream))
+  (let ((*standard-output* (stream-synonym-of stream))
 	(pathname pathname))
     (if verbose
 	(print-directory-verbose pathname all return-list)
diff --git a/code/globals.lisp b/code/globals.lisp
index 2a38a74d6df07fc5de0752e764c24c359537e091..e719e7ffb63c227fd7409d1f528d12cf6b56dd56 100644
--- a/code/globals.lisp
+++ b/code/globals.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/globals.lisp,v 1.15 1998/02/05 18:51:14 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/globals.lisp,v 1.16 1998/05/04 01:27:14 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -64,3 +64,13 @@
 		hemlock-internals::device-init 
 		hemlock::ts-stream-p hemlock::ts-stream-wire
 		hemlock-internals::window-hunk))
+
+;;; Gray streams functions not defined until after PCL is loaded.
+(declaim (ftype (function * *)
+		stream-advance-to-column stream-clear-input 
+		stream-clear-output stream-finish-output stream-force-output
+		stream-fresh-line stream-line-column stream-line-length
+		stream-listen stream-peek-char stream-read-byte
+		stream-read-char stream-read-char-no-hang stream-read-line
+		stream-start-line-p stream-terpri stream-unread-char
+		stream-write-byte stream-write-char stream-write-string))
diff --git a/code/load.lisp b/code/load.lisp
index 2d0ae537bb87355284a70aaffacb025d07ba7c03..ac527ac9ee8771066d2c16f51a3b63227edb9795 100644
--- a/code/load.lisp
+++ b/code/load.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.69 1998/03/21 08:11:58 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.70 1998/05/04 01:27:14 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -66,7 +66,7 @@
   "Count of the number of recursive loads.")
 (declaim (type index *load-depth*))
 (defvar *fasl-file*)
-(declaim (type stream fasl-file))
+(declaim (type lisp-stream fasl-file))
 
 
 ;;; LOAD-FRESH-LINE -- internal.
diff --git a/code/pprint.lisp b/code/pprint.lisp
index 3d708c7b7f8766d8d7110653e7a88f9a924213bb..47afb120021b6e6b54f2dde39fc980cd0dfc152e 100644
--- a/code/pprint.lisp
+++ b/code/pprint.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.23 1998/02/24 17:36:10 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.24 1998/05/04 01:27:14 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -45,7 +45,7 @@
 (defconstant default-line-length 80)
 
 (defstruct (pretty-stream
-	    (:include stream
+	    (:include sys:lisp-stream
 		      (:out #'pretty-out)
 		      (:sout #'pretty-sout)
 		      (:misc #'pretty-misc))
diff --git a/code/print.lisp b/code/print.lisp
index dd2d11998b7405490d7e0bc4a6059e516ad9e466..058932a8e27d068bb55972cd630552b315746df4 100644
--- a/code/print.lisp
+++ b/code/print.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.70 1998/04/03 03:37:02 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.71 1998/05/04 01:27:15 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -148,14 +148,14 @@
 		     ((:pprint-dispatch *print-pprint-dispatch*)
 		      *print-pprint-dispatch*))
   "Outputs OBJECT to the specified stream, defaulting to *standard-output*"
-  (output-object object (out-synonym-of stream))
+  (output-object object (stream-synonym-of stream))
   object)
 
 (defun prin1 (object &optional stream)
   "Outputs a mostly READable printed representation of OBJECT on the specified
   stream."
   (let ((*print-escape* T))
-    (output-object object (out-synonym-of stream)))
+    (output-object object (stream-synonym-of stream)))
   object)
 
 (defun princ (object &optional stream)
@@ -163,13 +163,13 @@
   specified stream."
   (let ((*print-escape* NIL)
 	(*print-readably* NIL))
-    (output-object object (out-synonym-of stream)))
+    (output-object object (stream-synonym-of stream)))
   object)
 
 (defun print (object &optional stream)
   "Outputs a terpri, the mostly READable printed represenation of OBJECT, and 
   space to the stream."
-  (let ((stream (out-synonym-of stream)))
+  (let ((stream (stream-synonym-of stream)))
     (terpri stream)
     (prin1 object stream)
     (write-char #\space stream)
@@ -179,7 +179,7 @@
   "Prettily outputs the Object preceded by a newline."
   (let ((*print-pretty* t)
 	(*print-escape* t)
-	(stream (out-synonym-of stream)))
+	(stream (stream-synonym-of stream)))
     (terpri stream)
     (output-object object stream))
   (values))
diff --git a/code/reader.lisp b/code/reader.lisp
index 89e2d7e4a05f0f74600fc82e5d4a1315b27642b8..d67100445814b9a51d74a19731e17efaab756519 100644
--- a/code/reader.lisp
+++ b/code/reader.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.24 1998/03/28 17:11:50 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.25 1998/05/04 01:27:15 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -333,15 +333,27 @@
 (defmacro eofp (char) `(eq ,char eof-object))
 
 (defun flush-whitespace (stream)
-  ;;This flushes whitespace chars, returning the last char it read (a non-white
-  ;;one).  It always gets an error on end-of-file.
-  (prepare-for-fast-read-char stream
-    (do ((attribute-table (character-attribute-table *readtable*))
-	 (char (fast-read-char t) (fast-read-char t)))
-      ((/= (the fixnum (aref attribute-table (char-code char))) #.whitespace)
-       (done-with-fast-read-char)
-       char))))
-
+  ;; This flushes whitespace chars, returning the last char it read (a
+  ;; non-white one).  It always gets an error on end-of-file.
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (prepare-for-fast-read-char stream
+	 (do ((attribute-table (character-attribute-table *readtable*))
+	      (char (fast-read-char t) (fast-read-char t)))
+	     ((/= (the fixnum (aref attribute-table (char-code char)))
+		  #.whitespace)
+	      (done-with-fast-read-char)
+	      char))))
+      (fundamental-stream
+       (do ((attribute-table (character-attribute-table *readtable*))
+	    (char (stream-read-char stream) (stream-read-char stream)))
+	   ((or (eq char :eof)
+		(/= (the fixnum (aref attribute-table (char-code char)))
+		    #.whitespace))
+	    (if (eq char :eof)
+		(error 'end-of-file :stream stream)
+		char)))))))
 
 
 ;;;; Temporary initialization hack.
@@ -531,11 +543,17 @@
 
 (defun read-comment (stream ignore)
   (declare (ignore ignore))
-  (prepare-for-fast-read-char stream
-    (do ((char (fast-read-char nil nil)
-	       (fast-read-char nil nil)))
-	((or (not char) (char= char #\newline))
-	 (done-with-fast-read-char))))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (prepare-for-fast-read-char stream
+         (do ((char (fast-read-char nil nil)
+		    (fast-read-char nil nil)))
+	     ((or (not char) (char= char #\newline))
+	      (done-with-fast-read-char)))))
+      (fundamental-stream
+       (do ((char (stream-read-char stream) (stream-read-char stream)))
+	   ((or (eq char :eof) (char= char #\newline)))))))
   ;;don't return anything
   (values))
 
@@ -587,12 +605,25 @@
   ;;this accumulates chars until it sees same char that invoked it.
   ;;for a very long string, this could end up bloating the read buffer.
   (reset-read-buffer)
-  (prepare-for-fast-read-char stream
-    (do ((char (fast-read-char t) (fast-read-char t)))
-	((char= char closech)
-	 (done-with-fast-read-char))
-      (if (escapep char) (setq char (fast-read-char t)))
-      (ouch-read-buffer char)))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (prepare-for-fast-read-char stream
+         (do ((char (fast-read-char t) (fast-read-char t)))
+	     ((char= char closech)
+	      (done-with-fast-read-char))
+	   (if (escapep char) (setq char (fast-read-char t)))
+	   (ouch-read-buffer char))))
+      (fundamental-stream
+       (do ((char (stream-read-char stream) (stream-read-char stream)))
+	   ((or (eq char :eof) (char= char closech))
+	    (if (eq char :eof)
+		(error 'end-of-file :stream stream)))
+	 (when (escapep char)
+	   (setq char (stream-read-char stream))
+	   (if (eq char :eof)
+	       (error 'end-of-file :stream stream)))
+	 (ouch-read-buffer char)))))
   (read-buffer-to-string))
 
 (defun read-right-paren (stream ignore)
@@ -953,23 +984,39 @@
 	(t (go SYMBOL)))
      SYMBOL
       ;;not a dot, dots, or number.
-      (prepare-for-fast-read-char stream
-	(prog ()
-	 SYMBOL-LOOP
-	  (ouch-read-buffer char)
-	  (setq char (fast-read-char nil nil))
-	  (unless char (go RETURN-SYMBOL))
-	  (case (char-class char attribute-table)
-	    (#.escape (done-with-fast-read-char)
-		      (go ESCAPE))
-	    (#.delimiter (done-with-fast-read-char)
-			 (unread-char char stream)
-			 (go RETURN-SYMBOL))
-	    (#.multiple-escape (done-with-fast-read-char)
-			       (go MULT-ESCAPE))
-	    (#.package-delimiter (done-with-fast-read-char)
-				 (go COLON))
-	    (t (go SYMBOL-LOOP)))))
+      (let ((stream (stream-synonym-of stream)))
+	(etypecase stream
+	  (lisp-stream
+	   (prepare-for-fast-read-char stream
+	     (prog ()
+	      SYMBOL-LOOP
+	      (ouch-read-buffer char)
+	      (setq char (fast-read-char nil nil))
+	      (unless char (go RETURN-SYMBOL))
+	      (case (char-class char attribute-table)
+		(#.escape (done-with-fast-read-char)
+			  (go ESCAPE))
+		(#.delimiter (done-with-fast-read-char)
+			     (unread-char char stream)
+			     (go RETURN-SYMBOL))
+		(#.multiple-escape (done-with-fast-read-char)
+				   (go MULT-ESCAPE))
+		(#.package-delimiter (done-with-fast-read-char)
+				     (go COLON))
+		(t (go SYMBOL-LOOP))))))
+	  (fundamental-stream
+	   (prog ()
+	    SYMBOL-LOOP
+	    (ouch-read-buffer char)
+	    (setq char (stream-read-char stream))
+	    (when (eq char :eof) (go RETURN-SYMBOL))
+	    (case (char-class char attribute-table)
+	      (#.escape (go ESCAPE))
+	      (#.delimiter (stream-unread-char stream char)
+			   (go RETURN-SYMBOL))
+	      (#.multiple-escape (go MULT-ESCAPE))
+	      (#.package-delimiter (go COLON))
+	      (t (go SYMBOL-LOOP)))))))
      ESCAPE
       ;;saw an escape.
       ;;don't put the escape in the read-buffer.
diff --git a/code/sharpm.lisp b/code/sharpm.lisp
index adaa6d2e390915173acfabfee523a24242b158f9..bd12f50abe9ef53da0d0d5e0323e1f82afc1eaa7 100644
--- a/code/sharpm.lisp
+++ b/code/sharpm.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sharpm.lisp,v 1.16 1998/04/17 00:42:59 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sharpm.lisp,v 1.17 1998/05/04 01:27:16 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -350,20 +350,36 @@
 
 (defun sharp-vertical-bar (stream sub-char numarg)
   (ignore-numarg sub-char numarg)
-  (prepare-for-fast-read-char stream
-    (do ((level 1)
-	 (prev (fast-read-char) char)
-	 (char (fast-read-char) (fast-read-char)))
-	(())
-      (cond ((and (char= prev #\|) (char= char #\#))
-	     (setq level (1- level))
-	     (when (zerop level)
-	       (done-with-fast-read-char)
-	       (return (values)))
-	     (setq char (fast-read-char)))
-	    ((and (char= prev #\#) (char= char #\|))
-	     (setq char (fast-read-char))
-	     (setq level (1+ level)))))))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (prepare-for-fast-read-char stream
+         (do ((level 1)
+	      (prev (fast-read-char) char)
+	      (char (fast-read-char) (fast-read-char)))
+	     (())
+	   (cond ((and (char= prev #\|) (char= char #\#))
+		  (setq level (1- level))
+		  (when (zerop level)
+		    (done-with-fast-read-char)
+		    (return (values)))
+		  (setq char (fast-read-char)))
+		 ((and (char= prev #\#) (char= char #\|))
+		  (setq char (fast-read-char))
+		  (setq level (1+ level)))))))
+      (fundamental-stream
+       (do ((level 1)
+	    (prev (read-char stream t) char)
+	    (char (read-char stream t) (read-char stream t)))
+	   (())
+	 (cond ((and (char= prev #\|) (char= char #\#))
+		(setq level (1- level))
+		(when (zerop level)
+		  (return (values)))
+		(setq char (read-char stream t)))
+	       ((and (char= prev #\#) (char= char #\|))
+		(setq char (read-char stream t))
+		(setq level (1+ level)))))))))
 
 (defun sharp-illegal (stream sub-char ignore)
   (declare (ignore ignore))
diff --git a/code/stream.lisp b/code/stream.lisp
index ae95fb43cc66ad6fb82e557b339a3f5f81ecf8b0..108da013a2c40926bc7d8446656d409291e7ccd3 100644
--- a/code/stream.lisp
+++ b/code/stream.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.29 1998/04/27 10:06:43 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.30 1998/05/04 01:27:16 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -163,37 +163,37 @@
 
 (defun input-stream-p (stream)
   "Returns non-nil if the given Stream can perform input operations."
-  (and (streamp stream)
-       (not (eq (stream-in stream) #'closed-flame))
-       (or (not (eq (stream-in stream) #'ill-in))
-	   (not (eq (stream-bin stream) #'ill-bin)))))
+  (and (lisp-stream-p stream)
+       (not (eq (lisp-stream-in stream) #'closed-flame))
+       (or (not (eq (lisp-stream-in stream) #'ill-in))
+	   (not (eq (lisp-stream-bin stream) #'ill-bin)))))
 
 (defun output-stream-p (stream)
   "Returns non-nil if the given Stream can perform output operations."
-  (and (streamp stream)
-       (not (eq (stream-in stream) #'closed-flame))
-       (or (not (eq (stream-out stream) #'ill-out))
-	   (not (eq (stream-bout stream) #'ill-bout)))))
+  (and (lisp-stream-p stream)
+       (not (eq (lisp-stream-in stream) #'closed-flame))
+       (or (not (eq (lisp-stream-out stream) #'ill-out))
+	   (not (eq (lisp-stream-bout stream) #'ill-bout)))))
 
 (defun open-stream-p (stream)
   "Return true if Stream is not closed."
   (declare (type stream stream))
-  (not (eq (stream-in stream) #'closed-flame)))
+  (not (eq (lisp-stream-in stream) #'closed-flame)))
 
 (defun stream-element-type (stream)
   "Returns a type specifier for the kind of object returned by the Stream."
   (declare (type stream stream))
-  (funcall (stream-misc stream) stream :element-type))
+  (funcall (lisp-stream-misc stream) stream :element-type))
 
 (defun interactive-stream-p (stream)
   "Return true if Stream does I/O on a terminal or other interactive device."
   (declare (type stream stream))
-  (funcall (stream-misc stream) stream :interactive-p))
+  (funcall (lisp-stream-misc stream) stream :interactive-p))
 
 (defun open-stream-p (stream)
   "Return true if and only if STREAM has not been closed."
   (declare (type stream stream))
-  (not (eq (stream-in stream) #'closed-flame)))
+  (not (eq (lisp-stream-in stream) #'closed-flame)))
 
 (defun close (stream &key abort)
   "Closes the given Stream.  No more I/O may be performed, but inquiries
@@ -201,18 +201,18 @@
   up the side effects of having created the stream."
   (declare (type stream stream))
   (when (open-stream-p stream)
-    (funcall (stream-misc stream) stream :close abort))
+    (funcall (lisp-stream-misc stream) stream :close abort))
   t)
 
 (defun set-closed-flame (stream)
-  (setf (stream-in stream) #'closed-flame)
-  (setf (stream-bin stream) #'closed-flame)
-  (setf (stream-n-bin stream) #'closed-flame)
-  (setf (stream-in stream) #'closed-flame)
-  (setf (stream-out stream) #'closed-flame)
-  (setf (stream-bout stream) #'closed-flame)
-  (setf (stream-sout stream) #'closed-flame)
-  (setf (stream-misc stream) #'closed-flame))
+  (setf (lisp-stream-in stream) #'closed-flame)
+  (setf (lisp-stream-bin stream) #'closed-flame)
+  (setf (lisp-stream-n-bin stream) #'closed-flame)
+  (setf (lisp-stream-in stream) #'closed-flame)
+  (setf (lisp-stream-out stream) #'closed-flame)
+  (setf (lisp-stream-bout stream) #'closed-flame)
+  (setf (lisp-stream-sout stream) #'closed-flame)
+  (setf (lisp-stream-misc stream) #'closed-flame))
 
 
 ;;;; File position and file length.
@@ -230,11 +230,11 @@
 	   (type (or index (member nil :start :end)) position))
   (cond
    (position
-    (setf (stream-in-index stream) in-buffer-length)
-    (funcall (stream-misc stream) stream :file-position position))
+    (setf (lisp-stream-in-index stream) in-buffer-length)
+    (funcall (lisp-stream-misc stream) stream :file-position position))
    (t
-    (let ((res (funcall (stream-misc stream) stream :file-position nil)))
-      (when res (- res (- in-buffer-length (stream-in-index stream))))))))
+    (let ((res (funcall (lisp-stream-misc stream) stream :file-position nil)))
+      (when res (- res (- in-buffer-length (lisp-stream-in-index stream))))))))
 
 
 ;;; File-Length  --  Public
@@ -244,7 +244,7 @@
 (defun file-length (stream)
   "This function returns the length of the file that File-Stream is open to."
   (declare (stream stream))
-  (funcall (stream-misc stream) stream :file-length))
+  (funcall (lisp-stream-misc stream) stream :file-length))
 
 
 ;;; Input functions:
@@ -254,34 +254,41 @@
   "Returns a line of text read from the Stream as a string, discarding the
   newline character."
   (declare (ignore recursive-p))
-  (prepare-for-fast-read-char stream
-    (let ((res (make-string 80))
-	  (len 80)
-	  (index 0))
-      (loop
-	(let ((ch (fast-read-char nil nil)))
-	  (cond (ch
-		 (when (char= ch #\newline)
-		   (done-with-fast-read-char)
-		   (return (values (shrink-vector res index) nil)))
-		 (when (= index len)
-		   (setq len (* len 2))
-		   (let ((new (make-string len)))
-		     (replace new res)
-		     (setq res new)))
-		 (setf (schar res index) ch)
-		 (incf index))
-		((zerop index)
-		 (done-with-fast-read-char)
-		 (return (values (eof-or-lose (in-synonym-of stream)
-					      eof-errorp eof-value)
-				 t)))
-		;; since fast-read-char hit already the eof char, we
-	        ;; shouldn't do another read-char
-		(t
-		 (done-with-fast-read-char)
-		 (return (values (shrink-vector res index) t)))))))))
-
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (prepare-for-fast-read-char stream
+         (let ((res (make-string 80))
+	       (len 80)
+	       (index 0))
+	   (loop
+	    (let ((ch (fast-read-char nil nil)))
+	      (cond (ch
+		     (when (char= ch #\newline)
+		       (done-with-fast-read-char)
+		       (return (values (shrink-vector res index) nil)))
+		     (when (= index len)
+		       (setq len (* len 2))
+		       (let ((new (make-string len)))
+			 (replace new res)
+			 (setq res new)))
+		     (setf (schar res index) ch)
+		     (incf index))
+		    ((zerop index)
+		     (done-with-fast-read-char)
+		     (return (values (eof-or-lose stream eof-errorp eof-value)
+				     t)))
+		    ;; since fast-read-char hit already the eof char, we
+		    ;; shouldn't do another read-char
+		    (t
+		     (done-with-fast-read-char)
+		     (return (values (shrink-vector res index) t)))))))))
+      (fundamental-stream
+       (multiple-value-bind (string eof)
+	   (stream-read-line stream)
+	 (if (and eof (zerop (length string)))
+	     (values (eof-or-lose stream eof-errorp eof-value) t)
+	     (values string eof)))))))
 
 ;;; We proclaim them inline here, then proclaim them notinline at EOF,
 ;;; so, except in this file, they are not inline by default, but they can be.
@@ -291,78 +298,139 @@
 			    recursive-p)
   "Inputs a character from Stream and returns it."
   (declare (ignore recursive-p))
-  (prepare-for-fast-read-char stream
-    (prog1
-	(fast-read-char eof-errorp eof-value)
-      (done-with-fast-read-char))))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (prepare-for-fast-read-char stream
+         (prog1
+	     (fast-read-char eof-errorp eof-value)
+	   (done-with-fast-read-char))))
+      (fundamental-stream
+       (let ((char (stream-read-char stream)))
+	 (if (eq char :eof)
+	     (eof-or-lose stream eof-errorp eof-value)
+	     char))))))
 
 (defun unread-char (character &optional (stream *standard-input*))
   "Puts the Character back on the front of the input Stream."
-  (let* ((stream (in-synonym-of stream))
-	 (index (1- (stream-in-index stream)))
-	 (buffer (stream-in-buffer stream)))
-    (declare (fixnum index))
-    (when (minusp index) (error "Nothing to unread."))
-    (cond (buffer
-	   (setf (aref buffer index) (char-code character))
-	   (setf (stream-in-index stream) index))
-	  (t
-	   (funcall (stream-misc stream) stream :unread character))))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (let ((index (1- (lisp-stream-in-index stream)))
+	     (buffer (lisp-stream-in-buffer stream)))
+	 (declare (fixnum index))
+	 (when (minusp index) (error "Nothing to unread."))
+	 (cond (buffer
+		(setf (aref buffer index) (char-code character))
+		(setf (lisp-stream-in-index stream) index))
+	       (t
+		(funcall (lisp-stream-misc stream) stream 
+			 :unread character)))))
+      (fundamental-stream
+       (stream-unread-char stream character))))
   nil)
 
 (defun peek-char (&optional (peek-type nil) (stream *standard-input*)
 			    (eof-errorp t) eof-value recursive-p)
   "Peeks at the next character in the input Stream.  See manual for details."
   (declare (ignore recursive-p))
-  (let* ((stream (in-synonym-of stream))
-	 (char (read-char stream eof-errorp eof-value)))
-    (cond ((eq char eof-value) char)
-	  ((characterp peek-type)
-	   (do ((char char (read-char stream eof-errorp eof-value)))
-	       ((or (eq char eof-value) (char= char peek-type))
-		(unless (eq char eof-value)
-		  (unread-char char stream))
-		char)))
-	  ((eq peek-type t)
-	   (do ((char char (read-char stream eof-errorp eof-value)))
-	       ((or (eq char eof-value) (not (whitespace-char-p char)))
-		(unless (eq char eof-value)
-		  (unread-char char stream))
-		char)))
-	  (t
-	   (unread-char char stream)
-	   char))))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (let ((char (read-char stream eof-errorp eof-value)))
+	 (cond ((eq char eof-value) char)
+	       ((characterp peek-type)
+		(do ((char char (read-char stream eof-errorp eof-value)))
+		    ((or (eq char eof-value) (char= char peek-type))
+		     (unless (eq char eof-value)
+		       (unread-char char stream))
+		     char)))
+	       ((eq peek-type t)
+		(do ((char char (read-char stream eof-errorp eof-value)))
+		    ((or (eq char eof-value) (not (whitespace-char-p char)))
+		     (unless (eq char eof-value)
+		       (unread-char char stream))
+		     char)))
+	       (t
+		(unread-char char stream)
+		char))))
+      (fundamental-stream
+       (cond ((characterp peek-type)
+	      (do ((char (stream-read-char stream) (stream-read-char stream)))
+		  ((or (eq char :eof) (char= char peek-type))
+		   (cond ((eq char :eof)
+			  (eof-or-lose stream eof-errorp eof-value))
+			 (t
+			  (stream-unread-char stream char)
+			  char)))))
+	     ((eq peek-type t)
+	      (do ((char (stream-read-char stream) (stream-read-char stream)))
+		  ((or (eq char :eof) (not (whitespace-char-p char)))
+		   (cond ((eq char :eof)
+			  (eof-or-lose stream eof-errorp eof-value))
+			 (t
+			  (stream-unread-char stream char)
+			  char)))))
+	     (t
+	      (let ((char (stream-peek-char stream)))
+		(if (eq char :eof)
+		    (eof-or-lose stream eof-errorp eof-value)
+		    char))))))))
 
 (defun listen (&optional (stream *standard-input*))
   "Returns T if a character is availible on the given Stream."
-  (let ((stream (in-synonym-of stream)))
-    (or (/= (the fixnum (stream-in-index stream)) in-buffer-length)
-	;; Test for t explicitly since misc methods return :eof sometimes.
-	(eq (funcall (stream-misc stream) stream :listen) t))))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (or (/= (the fixnum (lisp-stream-in-index stream)) in-buffer-length)
+	   ;; Test for t explicitly since misc methods return :eof sometimes.
+	   (eq (funcall (lisp-stream-misc stream) stream :listen) t)))
+      (fundamental-stream
+       (stream-listen stream)))))
 
 (defun read-char-no-hang (&optional (stream *standard-input*)
 				    (eof-errorp t) eof-value recursive-p)
   "Returns the next character from the Stream if one is availible, or nil."
   (declare (ignore recursive-p))
-  (let ((stream (in-synonym-of stream)))
-    (if (funcall (stream-misc stream) stream :listen)
-	;; On t or :eof get READ-CHAR to do the work.
-	(read-char stream eof-errorp eof-value)
-	nil)))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (if (funcall (lisp-stream-misc stream) stream :listen)
+	   ;; On t or :eof get READ-CHAR to do the work.
+	   (read-char stream eof-errorp eof-value)
+	   nil))
+      (fundamental-stream
+       (let ((char (stream-read-char-no-hang stream)))
+	 (if (eq char :eof)
+	     (eof-or-lose stream eof-errorp eof-value)
+	     char))))))
+
 
 (defun clear-input (&optional (stream *standard-input*))
   "Clears any buffered input associated with the Stream."
-  (let ((stream (in-synonym-of stream)))
-    (setf (stream-in-index stream) in-buffer-length)
-    (funcall (stream-misc stream) stream :clear-input)
-    nil))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (setf (lisp-stream-in-index stream) in-buffer-length)
+       (funcall (lisp-stream-misc stream) stream :clear-input))
+      (fundamental-stream
+       (stream-clear-input stream))))
+  nil)
 
 (defun read-byte (stream &optional (eof-errorp t) eof-value)
   "Returns the next byte of the Stream."
-  (prepare-for-fast-read-byte stream
-    (prog1
-	(fast-read-byte eof-errorp eof-value t)
-      (done-with-fast-read-byte))))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (prepare-for-fast-read-byte stream
+         (prog1
+	     (fast-read-byte eof-errorp eof-value t)
+	   (done-with-fast-read-byte))))
+      (fundamental-stream
+       (let ((char (stream-read-byte stream)))
+	 (if (eq char :eof)
+	     (eof-or-lose stream eof-errorp eof-value)
+	     char))))))
 
 (defun read-n-bytes (stream buffer start numbytes &optional (eof-errorp t))
   "Reads Numbytes bytes into the Buffer starting at Start, returning the number
@@ -373,25 +441,26 @@
       available (up to count bytes.)  On pipes or similar devices, this
       function returns as soon as any adata is available, even if the amount
       read is less than Count and eof has not been hit."
-  (declare (type index numbytes start)
+  (declare (type lisp-stream stream)
+	   (type index numbytes start)
 	   (type (or (simple-array * (*)) system-area-pointer) buffer))
-  (let* ((stream (in-synonym-of stream))
-	 (in-buffer (stream-in-buffer stream))
-	 (index (stream-in-index stream))
+  (let* ((stream (stream-synonym-of stream lisp-stream))
+	 (in-buffer (lisp-stream-in-buffer stream))
+	 (index (lisp-stream-in-index stream))
 	 (num-buffered (- in-buffer-length index)))
     (declare (fixnum index num-buffered))
     (cond
      ((not in-buffer)
-      (funcall (stream-n-bin stream) stream buffer start numbytes eof-errorp))
+      (funcall (lisp-stream-n-bin stream) stream buffer start numbytes eof-errorp))
      ((<= numbytes num-buffered)
       (%primitive byte-blt in-buffer index buffer start (+ start numbytes))
-      (setf (stream-in-index stream) (+ index numbytes))
+      (setf (lisp-stream-in-index stream) (+ index numbytes))
       numbytes)
      (t
       (let ((end (+ start num-buffered)))
 	(%primitive byte-blt in-buffer index buffer start end)
-	(setf (stream-in-index stream) in-buffer-length)
-	(+ (funcall (stream-n-bin stream) stream buffer end
+	(setf (lisp-stream-in-index stream) in-buffer-length)
+	(+ (funcall (lisp-stream-n-bin stream) stream buffer end
 		    (- numbytes num-buffered)
 		    eof-errorp)
 	   num-buffered))))))
@@ -409,16 +478,16 @@
 ;;; myst be an n-bin method.
 ;;;
 (defun fast-read-char-refill (stream eof-errorp eof-value)
-  (let* ((ibuf (stream-in-buffer stream))
-	 (count (funcall (stream-n-bin stream) stream
+  (let* ((ibuf (lisp-stream-in-buffer stream))
+	 (count (funcall (lisp-stream-n-bin stream) stream
 			 ibuf in-buffer-extra
 			 (- in-buffer-length in-buffer-extra)
 			 nil))
 	 (start (- in-buffer-length count)))
     (declare (type index start count))
     (cond ((zerop count)
-	   (setf (stream-in-index stream) in-buffer-length)
-	   (funcall (stream-in stream) stream eof-errorp eof-value))
+	   (setf (lisp-stream-in-index stream) in-buffer-length)
+	   (funcall (lisp-stream-in stream) stream eof-errorp eof-value))
 	  (t
 	   (when (/= start in-buffer-extra)
 	     (bit-bash-copy ibuf (+ (* in-buffer-extra vm:byte-bits)
@@ -426,7 +495,7 @@
 			    ibuf (+ (the index (* start vm:byte-bits))
 				    (* vm:vector-data-offset vm:word-bits))
 			    (* count vm:byte-bits)))
-	   (setf (stream-in-index stream) (1+ start))
+	   (setf (lisp-stream-in-index stream) (1+ start))
 	   (code-char (aref ibuf start))))))
 
 
@@ -436,22 +505,22 @@
 ;;; unreading.
 ;;;
 (defun fast-read-byte-refill (stream eof-errorp eof-value)
-  (let* ((ibuf (stream-in-buffer stream))
-	 (count (funcall (stream-n-bin stream) stream
+  (let* ((ibuf (lisp-stream-in-buffer stream))
+	 (count (funcall (lisp-stream-n-bin stream) stream
 			 ibuf 0 in-buffer-length
 			 nil))
 	 (start (- in-buffer-length count)))
     (declare (type index start count))
     (cond ((zerop count)
-	   (setf (stream-in-index stream) in-buffer-length)
-	   (funcall (stream-bin stream) stream eof-errorp eof-value))
+	   (setf (lisp-stream-in-index stream) in-buffer-length)
+	   (funcall (lisp-stream-bin stream) stream eof-errorp eof-value))
 	  (t
 	   (unless (zerop start)
 	     (bit-bash-copy ibuf (* vm:vector-data-offset vm:word-bits)
 			    ibuf (+ (the index (* start vm:byte-bits))
 				    (* vm:vector-data-offset vm:word-bits))
 			    (* count vm:byte-bits)))
-	   (setf (stream-in-index stream) (1+ start))
+	   (setf (lisp-stream-in-index stream) (1+ start))
 	   (aref ibuf start)))))
   
 
@@ -459,21 +528,26 @@
 
 (defun write-char (character &optional (stream *standard-output*))
   "Outputs the Character to the Stream."
-  (with-out-stream stream stream-out character)
+  (with-stream stream (lisp-stream-out character)
+	       (stream-write-char character))
   character)
 
 (defun terpri (&optional (stream *standard-output*))
   "Outputs a new line to the Stream."
-  (with-out-stream stream stream-out #\newline)
+  (with-stream stream (lisp-stream-out #\newline) (stream-terpri))
   nil)
 
 (defun fresh-line (&optional (stream *standard-output*))
   "Outputs a new line to the Stream if it is not positioned at the begining of
    a line.  Returns T if it output a new line, nil otherwise."
-  (let ((stream (out-synonym-of stream)))
-    (when (/= (or (charpos stream) 1) 0)
-      (funcall (stream-out stream) stream #\newline)
-      t)))
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (when (/= (or (charpos stream) 1) 0)
+	 (funcall (lisp-stream-out stream) stream #\newline)
+	 t))
+      (fundamental-stream
+       (stream-fresh-line stream)))))
 
 (defun write-string (string &optional (stream *standard-output*)
 			    &key (start 0) (end (length (the vector string))))
@@ -483,11 +557,18 @@
 (defun write-string* (string &optional (stream *standard-output*)
 			     (start 0) (end (length (the vector string))))
   (declare (fixnum start end))
-  (if (array-header-p string)
-      (with-array-data ((data string) (offset-start start) (offset-end end))
-	(with-out-stream stream stream-sout data offset-start offset-end))
-      (with-out-stream stream stream-sout string start end))
-  string)
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (if (array-header-p string)
+	   (with-array-data ((data string) (offset-start start)
+			     (offset-end end))
+	     (funcall (lisp-stream-sout stream)
+		      stream data offset-start offset-end))
+	   (funcall (lisp-stream-sout stream) stream string start end))
+       string)
+      (fundamental-stream
+       (stream-write-string stream string start end)))))
 
 (defun write-line (string &optional (stream *standard-output*)
 			  &key (start 0) (end (length string)))
@@ -497,48 +578,55 @@
 (defun write-line* (string &optional (stream *standard-output*)
 			   (start 0) (end (length string)))
   (declare (fixnum start end))
-  (let ((stream (out-synonym-of stream)))
-    (if (array-header-p string)
-	(with-array-data ((data string) (offset-start start) (offset-end end))
-	  (with-out-stream stream stream-sout data offset-start offset-end))
-	(with-out-stream stream stream-sout string start end))
-    (funcall (stream-out stream) stream #\newline))
-  string)
+  (let ((stream (stream-synonym-of stream)))
+    (etypecase stream
+      (lisp-stream
+       (if (array-header-p string)
+	   (with-array-data ((data string) (offset-start start)
+			     (offset-end end))
+	     (with-stream stream (lisp-stream-sout data offset-start
+						   offset-end)))
+	   (with-stream stream (lisp-stream-sout string start end)))
+       (funcall (lisp-stream-out stream) stream #\newline))
+      (fundamental-stream
+       (stream-write-string stream string start end)
+       (stream-write-char stream #\Newline)))
+    string))
 
 (defun charpos (&optional (stream *standard-output*))
   "Returns the number of characters on the current line of output of the given
   Stream, or Nil if that information is not availible."
-  (with-out-stream stream stream-misc :charpos))
+  (with-stream stream (lisp-stream-misc :charpos) (stream-line-column)))
 
 (defun line-length (&optional (stream *standard-output*))
   "Returns the number of characters that will fit on a line of output on the
   given Stream, or Nil if that information is not available."
-  (with-out-stream stream stream-misc :line-length))
+  (with-stream stream (lisp-stream-misc :line-length) (stream-line-length)))
 
 (defun finish-output (&optional (stream *standard-output*))
   "Attempts to ensure that all output sent to the Stream has reached its
    destination, and only then returns."
-  (with-out-stream stream stream-misc :finish-output)
+  (with-stream stream (lisp-stream-misc :finish-output) (stream-finish-output))
   nil)
 
 (defun force-output (&optional (stream *standard-output*))
   "Attempts to force any buffered output to be sent."
-  (with-out-stream stream stream-misc :force-output)
+  (with-stream stream (lisp-stream-misc :force-output) (stream-force-output))
   nil)
 
 (defun clear-output (&optional (stream *standard-output*))
   "Clears the given output Stream."
-  (with-out-stream stream stream-misc :clear-output)
+  (with-stream stream (lisp-stream-misc :clear-output) (stream-force-output))
   nil)
 
 (defun write-byte (integer stream)
   "Outputs the Integer to the binary Stream."
-  (with-out-stream stream stream-bout integer)
+  (with-stream stream (lisp-stream-bout integer) (stream-write-byte))
   integer)
 
 ;;;; Broadcast streams:
 
-(defstruct (broadcast-stream (:include stream
+(defstruct (broadcast-stream (:include lisp-stream
 				       (out #'broadcast-out)
 				       (bout #'broadcast-bout)
 				       (sout #'broadcast-sout)
@@ -559,37 +647,37 @@
 	     `(defun ,fun (stream ,@args)
 		(dolist (stream (broadcast-stream-streams stream))
 		  (funcall (,method stream) stream ,@args)))))
-  (out-fun broadcast-out stream-out char)
-  (out-fun broadcast-bout stream-bout byte)
-  (out-fun broadcast-sout stream-sout string start end))
+  (out-fun broadcast-out lisp-stream-out char)
+  (out-fun broadcast-bout lisp-stream-bout byte)
+  (out-fun broadcast-sout lisp-stream-sout string start end))
 
 (defun broadcast-misc (stream operation &optional arg1 arg2)
   (let ((streams (broadcast-stream-streams stream)))
     (case operation
       (:charpos
        (dolist (stream streams)
-	 (let ((charpos (funcall (stream-misc stream) stream :charpos)))
+	 (let ((charpos (funcall (lisp-stream-misc stream) stream :charpos)))
 	   (if charpos (return charpos)))))
       (:line-length
        (let ((min nil))
 	 (dolist (stream streams min)
-	   (let ((res (funcall (stream-misc stream) stream :line-length)))
+	   (let ((res (funcall (lisp-stream-misc stream) stream :line-length)))
 	     (when res (setq min (if min (min res min) res)))))))
       (:element-type
        (let (res)
 	 (dolist (stream streams (if (> (length res) 1) `(and ,@res) res))
-	   (pushnew (funcall (stream-misc stream) stream :element-type) res
+	   (pushnew (funcall (lisp-stream-misc stream) stream :element-type) res
 		    :test #'equal))))
       (:close)
       (t
        (let ((res nil))
 	 (dolist (stream streams res)
-	   (setq res (funcall (stream-misc stream) stream operation
+	   (setq res (funcall (lisp-stream-misc stream) stream operation
 			      arg1 arg2))))))))
 
 ;;;; Synonym Streams:
 
-(defstruct (synonym-stream (:include stream
+(defstruct (synonym-stream (:include lisp-stream
 				     (in #'synonym-in)
 				     (bin #'synonym-bin)
 				     (n-bin #'synonym-n-bin)
@@ -618,9 +706,9 @@
 		(declare (optimize (safety 1)))
 		(let ((syn (symbol-value (synonym-stream-symbol stream))))
 		  (funcall (,slot syn) syn ,@args)))))
-  (out-fun synonym-out stream-out ch)
-  (out-fun synonym-bout stream-bout n)
-  (out-fun synonym-sout stream-sout string start end))
+  (out-fun synonym-out lisp-stream-out ch)
+  (out-fun synonym-bout lisp-stream-bout n)
+  (out-fun synonym-sout lisp-stream-sout string start end))
 
 
 ;;; Bind synonym stream to this so that SPIO can turn on the right frob in
@@ -652,15 +740,15 @@
   (let ((syn (symbol-value (synonym-stream-symbol stream)))
 	(*previous-stream* stream))
     (case operation
-      (:listen (or (/= (the fixnum (stream-in-index syn)) in-buffer-length)
-		   (funcall (stream-misc syn) syn :listen)))
+      (:listen (or (/= (the fixnum (lisp-stream-in-index syn)) in-buffer-length)
+		   (funcall (lisp-stream-misc syn) syn :listen)))
       (t
-       (funcall (stream-misc syn) syn operation arg1 arg2)))))
+       (funcall (lisp-stream-misc syn) syn operation arg1 arg2)))))
 
 ;;;; Two-Way streams:
 
 (defstruct (two-way-stream
-	    (:include stream
+	    (:include lisp-stream
 		      (in #'two-way-in)
 		      (bin #'two-way-bin)
 		      (n-bin #'two-way-n-bin)
@@ -689,9 +777,9 @@
 	     `(defun ,name (stream ,@args)
 		(let ((syn (two-way-stream-output-stream stream)))
 		  (funcall (,slot syn) syn ,@args)))))
-  (out-fun two-way-out stream-out ch)
-  (out-fun two-way-bout stream-bout n)
-  (out-fun two-way-sout stream-sout string start end))
+  (out-fun two-way-out lisp-stream-out ch)
+  (out-fun two-way-bout lisp-stream-bout n)
+  (out-fun two-way-sout lisp-stream-sout string start end))
 
 (macrolet ((in-fun (name fun &rest args)
 	     `(defun ,name (stream ,@args)
@@ -703,11 +791,11 @@
 
 (defun two-way-misc (stream operation &optional arg1 arg2)
   (let* ((in (two-way-stream-input-stream stream))
-	 (in-method (stream-misc in))
+	 (in-method (lisp-stream-misc in))
 	 (out (two-way-stream-output-stream stream))
-	 (out-method (stream-misc out)))
+	 (out-method (lisp-stream-misc out)))
     (case operation
-      (:listen (or (/= (the fixnum (stream-in-index in)) in-buffer-length)
+      (:listen (or (/= (the fixnum (lisp-stream-in-index in)) in-buffer-length)
 		   (funcall in-method in :listen)))
       ((:finish-output :force-output :clear-output)
        (funcall out-method out operation arg1 arg2))
@@ -727,7 +815,7 @@
 ;;;; Concatenated Streams:
 
 (defstruct (concatenated-stream
-	    (:include stream
+	    (:include lisp-stream
 		      (in #'concatenated-in)
 		      (bin #'concatenated-bin)
 		      (misc #'concatenated-misc))
@@ -765,7 +853,7 @@
   (let ((left (concatenated-stream-current stream)))
     (when left
       (let* ((current (car left))
-	     (misc (stream-misc current)))
+	     (misc (lisp-stream-misc current)))
 	(case operation
 	  (:listen
 	   (loop
@@ -778,7 +866,7 @@
 		      (unless current
 			;; No further streams.  EOF.
 			(return :eof))
-		      (setf misc (stream-misc current)))
+		      (setf misc (lisp-stream-misc current)))
 		     (stuff
 		      ;; Stuff's available.
 		      (return t))
@@ -811,17 +899,17 @@
 			   (result (,fun in ,@args)))
 		      (funcall (,out-slot out) out result)
 		      result)))))
-  (in-fun echo-in read-char stream-out eof-errorp eof-value)
-  (in-fun echo-bin read-byte stream-bout eof-errorp eof-value))
+  (in-fun echo-in read-char lisp-stream-out eof-errorp eof-value)
+  (in-fun echo-bin read-byte lisp-stream-bout eof-errorp eof-value))
 
 (defun echo-misc (stream operation &optional arg1 arg2)
   (let* ((in (two-way-stream-input-stream stream))
-	 (in-method (stream-misc in))
+	 (in-method (lisp-stream-misc in))
 	 (out (two-way-stream-output-stream stream))
-	 (out-method (stream-misc out)))
+	 (out-method (lisp-stream-misc out)))
     (case operation
       (:listen (or (not (null (echo-stream-unread-stuff stream)))
-		   (/= (the fixnum (stream-in-index in)) in-buffer-length)
+		   (/= (the fixnum (lisp-stream-in-index in)) in-buffer-length)
 		   (funcall in-method in :listen)))
       (:unread (push arg1 (echo-stream-unread-stuff stream)))
       (:element-type
@@ -849,7 +937,7 @@
 ;;;; String Input Streams:
 
 (defstruct (string-input-stream
-	     (:include stream
+	     (:include lisp-stream
 		       (in #'string-inch)
 		       (bin #'string-binch)
 		       (n-bin #'string-stream-read-n-bytes)
@@ -934,7 +1022,7 @@
 ;;;; String Output Streams:
 
 (defstruct (string-output-stream
-	    (:include stream
+	    (:include lisp-stream
 		      (out #'string-ouch)
 		      (sout #'string-sout)
 		      (misc #'string-out-misc))
@@ -1016,8 +1104,8 @@
 (defun dump-output-stream-string (in-stream out-stream)
   "Dumps the characters buffer up in the In-Stream to the Out-Stream as
   Get-Output-Stream-String would return them."
-  (write-string (string-output-stream-string in-stream) out-stream
-		:start 0 :end (string-output-stream-index in-stream))
+  (write-string* (string-output-stream-string in-stream) out-stream
+		 0 (string-output-stream-index in-stream))
   (setf (string-output-stream-index in-stream) 0))
 
 ;;;; Fill-pointer streams:
@@ -1026,7 +1114,7 @@
 ;;; the CLM, but they are required for the implementation of With-Output-To-String.
 
 (defstruct (fill-pointer-output-stream
- 	    (:include stream
+ 	    (:include lisp-stream
 		      (out #'fill-pointer-ouch)
 		      (sout #'fill-pointer-sout)
 		      (misc #'fill-pointer-misc))
@@ -1107,7 +1195,7 @@
 
 ;;;; Indenting streams:
 
-(defstruct (indenting-stream (:include stream
+(defstruct (indenting-stream (:include lisp-stream
 				       (out #'indenting-out)
 				       (sout #'indenting-sout)
 				       (misc #'indenting-misc))
@@ -1132,15 +1220,15 @@
   `(do ((i 0 (+ i 60))
 	(indentation (indenting-stream-indentation ,stream)))
        ((>= i indentation))
-     (funcall (stream-sout ,sub-stream) ,sub-stream
-	      "                                                            "
-	      0 (min 60 (- indentation i)))))
+     (write-string*
+      "                                                            "
+      ,sub-stream 0 (min 60 (- indentation i)))))
 
 ;;; Indenting-Out writes a character to an indenting stream.
 
 (defun indenting-out (stream char)
   (let ((sub-stream (indenting-stream-stream stream)))
-    (funcall (stream-out sub-stream) sub-stream char)
+    (write-char char sub-stream)
     (if (char= char #\newline)
 	(indenting-indent stream sub-stream))))
 
@@ -1153,11 +1241,11 @@
       ((= i end))
     (let ((newline (position #\newline string :start i :end end)))
       (cond (newline
-	     (funcall (stream-sout sub-stream) sub-stream string i (1+ newline))
+	     (write-string* string sub-stream i (1+ newline))
 	     (indenting-indent stream sub-stream)
 	     (setq i (+ newline 1)))
 	    (t
-	     (funcall (stream-sout sub-stream) sub-stream string i end)
+	     (write-string* string sub-stream i end)
 	     (setq i end))))))
 
 ;;; Indenting-Misc just treats just the :Line-Length message differently.
@@ -1165,20 +1253,36 @@
 ;;; the stream's indentation.
 
 (defun indenting-misc (stream operation &optional arg1 arg2)
-  (let* ((sub-stream (indenting-stream-stream stream))
-	 (method (stream-misc sub-stream)))
-    (case operation
-      (:line-length
-       (let ((line-length (funcall method sub-stream operation)))
-	 (if line-length
-	     (- line-length (indenting-stream-indentation stream)))))
-      (:charpos
-       (let* ((sub-stream (indenting-stream-stream stream))
-	      (charpos (funcall method sub-stream operation)))
-	 (if charpos
-	     (- charpos (indenting-stream-indentation stream)))))       
-      (t
-       (funcall method sub-stream operation arg1 arg2)))))
+  (let ((sub-stream (indenting-stream-stream stream)))
+    (etypecase sub-stream
+      (lisp-stream
+       (let ((method (lisp-stream-misc sub-stream)))
+	 (case operation
+	   (:line-length
+	    (let ((line-length (funcall method sub-stream operation)))
+	      (if line-length
+		  (- line-length (indenting-stream-indentation stream)))))
+	   (:charpos
+	    (let ((charpos (funcall method sub-stream operation)))
+	      (if charpos
+		  (- charpos (indenting-stream-indentation stream)))))       
+	   (t
+	    (funcall method sub-stream operation arg1 arg2)))))
+      (fundamental-stream
+       (case operation
+	 (:line-length
+	  (let ((line-length (stream-line-length sub-stream)))
+	    (if line-length
+		(- line-length (indenting-stream-indentation stream)))))
+	 (:charpos
+	  (let ((charpos (stream-line-column sub-stream)))
+	    (if charpos
+		(- charpos (indenting-stream-indentation stream)))))
+	 (t
+	  ;; XX TODO 
+	  (format t "* Warning: ignoring ~s ~s ~s on ~s~%"
+		  operation arg1 arg2 sub-stream)))))))
+
 
 (proclaim '(maybe-inline read-char unread-char read-byte listen))
 
@@ -1187,7 +1291,7 @@
 ;;;; Case frobbing streams, used by format ~(...~).
 
 (defstruct (case-frob-stream
-	    (:include stream
+	    (:include lisp-stream
 		      (:misc #'case-frob-misc))
 	    (:constructor %make-case-frob-stream (target out sout)))
   (target (required-argument) :type stream))
@@ -1233,14 +1337,14 @@
     (:close)
     (t
      (let ((target (case-frob-stream-target stream)))
-       (funcall (stream-misc target) target op arg1 arg2)))))
+       (funcall (lisp-stream-misc target) target op arg1 arg2)))))
 
 
 (defun case-frob-upcase-out (stream char)
   (declare (type case-frob-stream stream)
 	   (type base-char char))
   (let ((target (case-frob-stream-target stream)))
-    (funcall (stream-out target) target (char-upcase char))))
+    (funcall (lisp-stream-out target) target (char-upcase char))))
 
 (defun case-frob-upcase-sout (stream str start end)
   (declare (type case-frob-stream stream)
@@ -1250,7 +1354,7 @@
   (let* ((target (case-frob-stream-target stream))
 	 (len (length str))
 	 (end (or end len)))
-    (funcall (stream-sout target) target
+    (funcall (lisp-stream-sout target) target
 	     (if (and (zerop start) (= len end))
 		 (string-upcase str)
 		 (nstring-upcase (subseq str start end)))
@@ -1261,7 +1365,7 @@
   (declare (type case-frob-stream stream)
 	   (type base-char char))
   (let ((target (case-frob-stream-target stream)))
-    (funcall (stream-out target) target (char-downcase char))))
+    (funcall (lisp-stream-out target) target (char-downcase char))))
 
 (defun case-frob-downcase-sout (stream str start end)
   (declare (type case-frob-stream stream)
@@ -1271,7 +1375,7 @@
   (let* ((target (case-frob-stream-target stream))
 	 (len (length str))
 	 (end (or end len)))
-    (funcall (stream-sout target) target
+    (funcall (lisp-stream-sout target) target
 	     (if (and (zerop start) (= len end))
 		 (string-downcase str)
 		 (nstring-downcase (subseq str start end)))
@@ -1283,13 +1387,13 @@
 	   (type base-char char))
   (let ((target (case-frob-stream-target stream)))
     (cond ((alphanumericp char)
-	   (funcall (stream-out target) target (char-upcase char))
+	   (funcall (lisp-stream-out target) target (char-upcase char))
 	   (setf (case-frob-stream-out stream)
 		 #'case-frob-capitalize-aux-out)
 	   (setf (case-frob-stream-sout stream)
 		 #'case-frob-capitalize-aux-sout))
 	  (t
-	   (funcall (stream-out target) target char)))))
+	   (funcall (lisp-stream-out target) target char)))))
 
 (defun case-frob-capitalize-sout (stream str start end)
   (declare (type case-frob-stream stream)
@@ -1314,16 +1418,16 @@
 	    #'case-frob-capitalize-aux-out)
       (setf (case-frob-stream-sout stream)
 	    #'case-frob-capitalize-aux-sout))
-    (funcall (stream-sout target) target str 0 len)))
+    (funcall (lisp-stream-sout target) target str 0 len)))
 
 (defun case-frob-capitalize-aux-out (stream char)
   (declare (type case-frob-stream stream)
 	   (type base-char char))
   (let ((target (case-frob-stream-target stream)))
     (cond ((alphanumericp char)
-	   (funcall (stream-out target) target (char-downcase char)))
+	   (funcall (lisp-stream-out target) target (char-downcase char)))
 	  (t
-	   (funcall (stream-out target) target char)
+	   (funcall (lisp-stream-out target) target char)
 	   (setf (case-frob-stream-out stream)
 		 #'case-frob-capitalize-out)
 	   (setf (case-frob-stream-sout stream)
@@ -1352,20 +1456,20 @@
 	    #'case-frob-capitalize-out)
       (setf (case-frob-stream-sout stream)
 	    #'case-frob-capitalize-sout))
-    (funcall (stream-sout target) target str 0 len)))
+    (funcall (lisp-stream-sout target) target str 0 len)))
 
 (defun case-frob-capitalize-first-out (stream char)
   (declare (type case-frob-stream stream)
 	   (type base-char char))
   (let ((target (case-frob-stream-target stream)))
     (cond ((alphanumericp char)
-	   (funcall (stream-out target) target (char-upcase char))
+	   (funcall (lisp-stream-out target) target (char-upcase char))
 	   (setf (case-frob-stream-out stream)
 		 #'case-frob-downcase-out)
 	   (setf (case-frob-stream-sout stream)
 		 #'case-frob-downcase-sout))
 	  (t
-	   (funcall (stream-out target) target char)))))
+	   (funcall (lisp-stream-out target) target char)))))
 
 (defun case-frob-capitalize-first-sout (stream str start end)
   (declare (type case-frob-stream stream)
@@ -1387,7 +1491,7 @@
 	  (setf (case-frob-stream-sout stream)
 		#'case-frob-downcase-sout)
 	  (return))))
-    (funcall (stream-sout target) target str 0 len)))
+    (funcall (lisp-stream-sout target) target str 0 len)))
 
 
 ;;;; Public interface from "EXTENSIONS" package.
@@ -1416,7 +1520,7 @@
   "This takes a stream and waits for text or a command to appear on it.  If
    text appears before a command, this returns nil, and otherwise it returns
    a command."
-  (let ((cmdp (funcall (lisp::stream-misc stream) stream :get-command)))
+  (let ((cmdp (funcall (lisp-stream-misc stream) stream :get-command)))
     (cond (cmdp)
 	  ((listen stream)
 	   nil)
@@ -1504,7 +1608,7 @@
 		    (type index i))
 	   (funcall write-function (first rem) stream))))
       (string
-       (write-string seq stream :start start :end end))
+       (write-string* seq stream start end))
       (vector
        (let ((write-function
 	      (if (subtypep (stream-element-type stream) 'character)
diff --git a/code/struct.lisp b/code/struct.lisp
index 4d09a42eb777ef13f58baac7fa0aef9b69a70baa..16ebb5926037b38b61378d2965142ce7c3977e20 100644
--- a/code/struct.lisp
+++ b/code/struct.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/struct.lisp,v 1.19 1994/10/31 04:11:27 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/struct.lisp,v 1.20 1998/05/04 01:27:16 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -20,13 +20,13 @@
 (deftype in-buffer-type ()
   `(simple-array (unsigned-byte 8) (,in-buffer-length)))
 
-;;; Change the kind of stream to :instance so that the defstruct doesn't flame
-;;; out.
+;;; Change the kind of lisp-stream to :instance so that the defstruct
+;;; doesn't flame out.
 ;;; 
 (eval-when (compile eval)
-  (setf (info type kind 'stream) :instance))
+  (setf (info type kind 'lisp-stream) :instance))
 
-(defstruct (stream (:predicate streamp) (:print-function %print-stream))
+(defstruct (lisp-stream (:print-function %print-stream))
   ;;
   ;; Buffered input.
   (in-buffer nil :type (or in-buffer-type null))
@@ -39,6 +39,9 @@
   (sout #'ill-out :type function)		; String output function
   (misc #'do-nothing :type function))		; Less used methods
 
+(declaim (inline streamp))
+(defun streamp (stream)
+  (typep stream 'stream))
 
 ;;; Alien value structures:
 
diff --git a/code/sysmacs.lisp b/code/sysmacs.lisp
index e20cecb77c296d7d27cd28794d2b86f2635ee017..668f46496620313d8f790bc9a1b4810df644b18b 100644
--- a/code/sysmacs.lisp
+++ b/code/sysmacs.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sysmacs.lisp,v 1.17 1994/10/31 04:11:27 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sysmacs.lisp,v 1.18 1998/05/04 01:27:17 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -88,35 +88,30 @@
        (error 'end-of-file :stream ,stream)
        ,eof-value))
 
-;;; These macros handle the special cases of t and nil for input and
+;;; This macros handle the special cases of t and nil for input and
 ;;; output streams.
 ;;;
-(defmacro in-synonym-of (stream)
-  (let ((svar (gensym)))
-    `(let ((,svar ,stream))
-       (cond ((null ,svar) *standard-input*)
-	     ((eq ,svar t) *terminal-io*)
-	     (t (check-type ,svar stream)
-		,svar)))))
-
-(defmacro out-synonym-of (stream)
+(defmacro stream-synonym-of (stream &optional check-type)
   (let ((svar (gensym)))
     `(let ((,svar ,stream))
        (cond ((null ,svar) *standard-output*)
 	     ((eq ,svar t) *terminal-io*)
-	     (T (check-type ,svar stream)
+	     (T ,@(if check-type `((check-type ,svar ,check-type)))
 		,svar)))))
 
 ;;; With-Mumble-Stream calls the function in the given Slot of the Stream with
-;;; the Args.
-;;;
-(defmacro with-in-stream (stream slot &rest args)
-  `(let ((stream (in-synonym-of ,stream)))
-     (funcall (,slot stream) stream ,@args)))
-
-(defmacro with-out-stream (stream slot &rest args)
-  `(let ((stream (out-synonym-of ,stream)))
-     (funcall (,slot stream) stream ,@args)))
+;;; the Args for lisp-streams or the pcl-fn for fundamental-streams.
+;;;
+(defmacro with-stream (stream lisp-dispatch &optional pcl-dispatch)
+  `(let ((stream (stream-synonym-of ,stream)))
+    (etypecase stream
+      (lisp-stream
+       ,(destructuring-bind (slot &rest args) lisp-dispatch
+          `(funcall (,slot stream) stream ,@args)))
+      ,@(when pcl-dispatch
+          `((fundamental-stream
+	     ,(destructuring-bind (pcl-fn &rest args) pcl-dispatch
+	        `(,pcl-fn stream ,@args))))))))
 
 
 ;;;; These are hacks to make the reader win.
@@ -127,20 +122,21 @@
 ;;; macro within the enclosed lexical scope.
 ;;;
 (defmacro prepare-for-fast-read-char (stream &body forms)
-  `(let* ((%frc-stream% (in-synonym-of ,stream))
-	  (%frc-method% (stream-in %frc-stream%))
-	  (%frc-buffer% (stream-in-buffer %frc-stream%))
-	  (%frc-index% (stream-in-index %frc-stream%)))
-     (declare (type index %frc-index%))
+  `(let* ((%frc-stream% (stream-synonym-of ,stream lisp-stream))
+	  (%frc-method% (lisp-stream-in %frc-stream%))
+	  (%frc-buffer% (lisp-stream-in-buffer %frc-stream%))
+	  (%frc-index% (lisp-stream-in-index %frc-stream%)))
+     (declare (type index %frc-index%)
+	      (type lisp-stream %frc-stream%))
      ,@forms))
 
 ;;; Done-With-Fast-Read-Char  --  Internal
 ;;;
 ;;;    This macro must be called after one is done with fast-read-char
-;;; inside it's scope to decache the stream-in-index.
+;;; inside it's scope to decache the lisp-stream-in-index.
 ;;;
 (defmacro done-with-fast-read-char ()
-  `(setf (stream-in-index %frc-stream%) %frc-index%))
+  `(setf (lisp-stream-in-index %frc-stream%) %frc-index%))
 
 ;;; Fast-Read-Char  --  Internal
 ;;;
@@ -153,7 +149,7 @@
      (funcall %frc-method% %frc-stream% ,eof-errorp ,eof-value))
     ((= %frc-index% in-buffer-length)
      (prog1 (fast-read-char-refill %frc-stream% ,eof-errorp ,eof-value)
-	    (setq %frc-index% (stream-in-index %frc-stream%))))
+	    (setq %frc-index% (lisp-stream-in-index %frc-stream%))))
     (t
      (prog1 (code-char (aref %frc-buffer% %frc-index%))
 	    (incf %frc-index%)))))
@@ -166,11 +162,12 @@
 ;;; method.
 ;;;
 (defmacro prepare-for-fast-read-byte (stream &body forms)
-  `(let* ((%frc-stream% (in-synonym-of ,stream))
-	  (%frc-method% (stream-bin %frc-stream%))
-	  (%frc-buffer% (stream-in-buffer %frc-stream%))
-	  (%frc-index% (stream-in-index %frc-stream%)))
-     (declare (type index %frc-index%))
+  `(let* ((%frc-stream% (stream-synonym-of ,stream lisp-stream))
+	  (%frc-method% (lisp-stream-bin %frc-stream%))
+	  (%frc-buffer% (lisp-stream-in-buffer %frc-stream%))
+	  (%frc-index% (lisp-stream-in-index %frc-stream%)))
+     (declare (type index %frc-index%)
+	      (type lisp-stream %frc-stream%))
      ,@forms))
 
 ;;; Fast-Read-Byte, Done-With-Fast-Read-Byte  --  Internal
@@ -187,7 +184,7 @@
       (funcall %frc-method% %frc-stream% ,eof-errorp ,eof-value))
      ((= %frc-index% in-buffer-length)
       (prog1 (fast-read-byte-refill %frc-stream% ,eof-errorp ,eof-value)
-	(setq %frc-index% (stream-in-index %frc-stream%))))
+	(setq %frc-index% (lisp-stream-in-index %frc-stream%))))
      (t
       (prog1 (aref %frc-buffer% %frc-index%)
 	(incf %frc-index%))))))
diff --git a/compiler/generic/core.lisp b/compiler/generic/core.lisp
index 397f564ebd29dfec8de30adc8264ef9df20183e8..2a21a483d29441e97112c4e330730626209e1a54 100644
--- a/compiler/generic/core.lisp
+++ b/compiler/generic/core.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/core.lisp,v 1.37 1997/11/11 18:51:58 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/core.lisp,v 1.38 1998/05/04 01:27:17 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -312,7 +312,7 @@
 
 (defstruct (code-instruction-stream
 	    (:print-function %print-code-inst-stream)
-	    (:include stream
+	    (:include lisp-stream
 		      (lisp::sout #'code-inst-stream-sout)
 		      (lisp::bout #'code-inst-stream-bout)
 		      (lisp::misc #'code-inst-stream-misc))
diff --git a/hemlock/bit-stream.lisp b/hemlock/bit-stream.lisp
index 68cb27d63e6ae3f76534a2340d64aa89b39588c0..218c5eca95c33cfef56409e32a9d3fa09515e78a 100644
--- a/hemlock/bit-stream.lisp
+++ b/hemlock/bit-stream.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/bit-stream.lisp,v 1.3 1994/10/31 04:50:12 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/bit-stream.lisp,v 1.4 1998/05/04 01:27:18 dtc Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -26,7 +26,7 @@
 ;;; does not invoke the exposed/changed handler in Bit-Screen.Lisp; also, the
 ;;; hunk's input and changed handler slots are not set.
 ;;;
-(defstruct (bitmap-hunk-output-stream (:include stream
+(defstruct (bitmap-hunk-output-stream (:include sys:lisp-stream
 						(out #'bitmap-hunk-out)
 						(sout #'bitmap-hunk-sout)
 						(misc #'bitmap-hunk-misc))
diff --git a/hemlock/eval-server.lisp b/hemlock/eval-server.lisp
index bc863514b22aa6eb9ab702fac930627e8218e4d6..5deb24db3296b4de78ab20e2de940de707150749 100644
--- a/hemlock/eval-server.lisp
+++ b/hemlock/eval-server.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/eval-server.lisp,v 1.6 1997/01/18 14:31:52 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/eval-server.lisp,v 1.7 1998/05/04 01:27:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -781,7 +781,7 @@
 
 (defvar *eval-form-stream*
   (make-two-way-stream
-   (lisp::make-stream
+   (lisp::make-lisp-stream
     :in #'(lambda (&rest junk)
 	    (declare (ignore junk))
 	    (error "You cannot read when handling an eval_form request.")))
diff --git a/hemlock/rompsite.lisp b/hemlock/rompsite.lisp
index 99601ba97df4ead2dc020b63bf5ddbd67d632d5d..108051d8c0593235608532f5d23ed2046139eb75 100644
--- a/hemlock/rompsite.lisp
+++ b/hemlock/rompsite.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/rompsite.lisp,v 1.10 1997/08/24 16:54:09 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/rompsite.lisp,v 1.11 1998/05/04 01:27:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -459,7 +459,7 @@
 	 stream))
 
 (defvar *illegal-read-stream*
-  (lisp::make-stream :in #'in-hemlock-standard-input-read))
+  (lisp::make-lisp-stream :in #'in-hemlock-standard-input-read))
 
 (defmacro site-wrapper-macro (&body body)
   `(unwind-protect
diff --git a/hemlock/shell.lisp b/hemlock/shell.lisp
index 2cb1f89f5d9e6dce8fa020b6b460e588a656e1b8..6d97d34798697ee9491dcc2d8cc1e8473a8ae8c5 100644
--- a/hemlock/shell.lisp
+++ b/hemlock/shell.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/shell.lisp,v 1.4 1994/10/31 04:50:12 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/shell.lisp,v 1.5 1998/05/04 01:27:20 dtc Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -63,7 +63,7 @@
 ;;;
 
 (defstruct (shell-filter-stream
-	    (:include stream
+	    (:include sys:lisp-stream
 		      (:out #'shell-filter-out)
 		      (:sout #'shell-filter-string-out)
 		      (:misc #'shell-filter-output-misc))
diff --git a/hemlock/streams.lisp b/hemlock/streams.lisp
index 878811f6783dde514aac87b7417dd27f7243b6ba..9e517e87bba4b883826586dc6ff7696f08821064 100644
--- a/hemlock/streams.lisp
+++ b/hemlock/streams.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/streams.lisp,v 1.4 1994/10/31 04:50:12 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/streams.lisp,v 1.5 1998/05/04 01:27:20 dtc Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -26,7 +26,7 @@
 	  modify-kbdmac-stream))
 
 (defstruct (hemlock-output-stream
-	    (:include stream
+	    (:include sys:lisp-stream
 		      (:misc #'hemlock-output-misc))
 	    (:print-function %print-hemlock-output-stream)
 	    (:constructor internal-make-hemlock-output-stream ()))
@@ -56,14 +56,14 @@
   (setf (hemlock-output-stream-mark stream) mark)
   (case buffered
     (:none
-     (setf (lisp::stream-out stream) #'hemlock-output-unbuffered-out
-	   (lisp::stream-sout stream) #'hemlock-output-unbuffered-sout))
+     (setf (lisp::lisp-stream-out stream) #'hemlock-output-unbuffered-out
+	   (lisp::lisp-stream-sout stream) #'hemlock-output-unbuffered-sout))
     (:line
-     (setf (lisp::stream-out stream) #'hemlock-output-line-buffered-out
-	   (lisp::stream-sout stream) #'hemlock-output-line-buffered-sout))
+     (setf (lisp::lisp-stream-out stream) #'hemlock-output-line-buffered-out
+	   (lisp::lisp-stream-sout stream) #'hemlock-output-line-buffered-sout))
     (:full
-     (setf (lisp::stream-out stream) #'hemlock-output-buffered-out
-	   (lisp::stream-sout stream) #'hemlock-output-buffered-sout))
+     (setf (lisp::lisp-stream-out stream) #'hemlock-output-buffered-out
+	   (lisp::lisp-stream-sout stream) #'hemlock-output-buffered-sout))
     (t
      (error "~S is a losing value for Buffered." buffered)))
   stream)
@@ -128,7 +128,7 @@
     (:element-type 'base-char)))
 
 (defstruct (hemlock-region-stream
-	    (:include stream
+	    (:include sys:lisp-stream
 		      (:in #'region-in)
 		      (:misc #'region-misc))
 	    (:print-function %print-region-stream)
diff --git a/hemlock/struct.lisp b/hemlock/struct.lisp
index 115c2a5f1fcd737d8cc29c067b74a1b6863a4dbf..a19b340e090e15e3b295f1713f18b47ab1af67a8 100644
--- a/hemlock/struct.lisp
+++ b/hemlock/struct.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/struct.lisp,v 1.5 1994/10/31 04:50:12 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/struct.lisp,v 1.6 1998/05/04 01:27:20 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -326,7 +326,7 @@
 
 ;;; These streams write to random typeout buffers for WITH-POP-UP-DISPLAY.
 ;;;
-(defstruct (random-typeout-stream (:include stream)
+(defstruct (random-typeout-stream (:include sys:lisp-stream)
 				  (:print-function print-random-typeout-stream)
 				  (:constructor
 				   make-random-typeout-stream (mark)))
diff --git a/hemlock/ts-stream.lisp b/hemlock/ts-stream.lisp
index b61905da53240f8086e83e554881c7bafd20d3b8..520b5ace406a176a01caed11e6abbf8ff1bdfcf5 100644
--- a/hemlock/ts-stream.lisp
+++ b/hemlock/ts-stream.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/ts-stream.lisp,v 1.3 1994/10/31 04:50:12 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/ts-stream.lisp,v 1.4 1998/05/04 01:27:21 dtc Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -23,7 +23,7 @@
 (defconstant ts-stream-output-buffer-size 512)
 
 (defstruct (ts-stream
-	    (:include stream
+	    (:include sys:lisp-stream
 		      (in #'%ts-stream-in)
 		      (out #'%ts-stream-out)
 		      (sout #'%ts-stream-sout)
diff --git a/hemlock/tty-stream.lisp b/hemlock/tty-stream.lisp
index 567bad9502b2cef48cd6ddfd79117a3676bc88ea..ced3d6312bec6fb1cc5e39d20350e8b8dc95f277 100644
--- a/hemlock/tty-stream.lisp
+++ b/hemlock/tty-stream.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-stream.lisp,v 1.3 1994/10/31 04:50:12 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-stream.lisp,v 1.4 1998/05/04 01:27:21 dtc Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -38,7 +38,7 @@
   (point-y 0 :type fixnum)
   (buffer "" :type simple-string))
 
-(defstruct (tty-hunk-output-stream (:include stream
+(defstruct (tty-hunk-output-stream (:include sys:lisp-stream
 					     (out #'hunk-out)
 					     (sout #'hunk-sout)
 					     (misc #'hunk-misc))
diff --git a/pcl/braid.lisp b/pcl/braid.lisp
index ff73a7ec63a64e6c4830e117cab5f6c7a8c41c1f..1b0df186d83bcd1010f19893dcc72ed8ec883406 100644
--- a/pcl/braid.lisp
+++ b/pcl/braid.lisp
@@ -626,6 +626,10 @@
 			       (list (lisp:class-name
 				      (first (kernel:class-direct-superclasses
 					      (lisp:find-class symbol))))))
+			      ;; Hack to add the stream class as a
+			      ;; mixin to the lisp-stream class.
+			      ((eq symbol 'sys:lisp-stream)
+			       '(structure-object stream))
 			      ((structure-type-included-type-name symbol)
 			       (list (structure-type-included-type-name symbol))))
 			:direct-slots
diff --git a/pcl/cache.lisp b/pcl/cache.lisp
index 427069ea112caeb9a9ac58db6c8e72a5b9389058..2f81d6fd9e2c6f3c3cdb321b39fada82a7b73c91 100644
--- a/pcl/cache.lisp
+++ b/pcl/cache.lisp
@@ -543,6 +543,13 @@
 	:class (kernel:make-standard-class :name name :pcl-class class)))))))
 
 
+;;; The following variable may be set to a standard-class that has
+;;; already been created by the lisp code and which is to be redefined
+;;; by PCL. This allows standard-classes to be defined and used for
+;;; type testing and dispatch before PCL is loaded.
+#+cmu17
+(defvar *pcl-class-boot* nil)
+
 #+cmu17
 ;;; MAKE-WRAPPER  --  Interface
 ;;;
@@ -563,7 +570,15 @@
 	       (kernel:layout-class owrap))
 	      ((*subtypep (class-of class)
 			  *the-class-standard-class*)
-	       (kernel:make-standard-class :pcl-class class))
+	       (cond ((and *pcl-class-boot*
+			   (eq (slot-value class 'name) *pcl-class-boot*))
+		      (let ((found (lisp:find-class (slot-value class 'name))))
+			(unless (kernel:class-pcl-class found)
+			  (setf (kernel:class-pcl-class found) class))
+			(assert (eq (kernel:class-pcl-class found) class))
+			found))
+		     (t
+		      (kernel:make-standard-class :pcl-class class))))
 	      (t
 	       (kernel:make-random-pcl-class :pcl-class class)))))))
    (t
diff --git a/pcl/defs.lisp b/pcl/defs.lisp
index fdb8d486e7b471f1ff41197d3413e95e98451b2e..976b9c18a6f3a85f0c1033d79a7e6b2af87105ce 100644
--- a/pcl/defs.lisp
+++ b/pcl/defs.lisp
@@ -182,6 +182,7 @@
                     *the-class-integer* *the-class-float* *the-class-cons*
                     *the-class-complex* *the-class-character*
                     *the-class-bit-vector* *the-class-array*
+		    *the-class-stream*
 
                     *the-class-slot-object*
                     *the-class-standard-object*
@@ -592,7 +593,7 @@
       (let* ((name (car bic))
 	     (class (lisp:find-class name)))
 	(unless (member name '(t kernel:instance kernel:funcallable-instance
-				 function))
+				 function stream))
 	  (res `(,name
 		 ,(mapcar #'lisp:class-name (direct-supers class))
 		 ,(mapcar #'lisp:class-name (direct-subs class))
@@ -621,6 +622,9 @@
     (:metaclass built-in-class))
 
   (defclass kernel:funcallable-instance (function) ()
+    (:metaclass built-in-class))
+
+  (defclass stream (t) ()
     (:metaclass built-in-class)))
 
 (defclass slot-object (#-cmu17 t #+cmu17 kernel:instance) ()
diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp
index aa30049e257b2a6069a256a200a3e939e998444e..6d24437ff4dcd0fbab953ed3758247d38b0cfd3c 100644
--- a/pcl/std-class.lisp
+++ b/pcl/std-class.lisp
@@ -1292,7 +1292,7 @@
 (defmethod class-default-initargs        ((class built-in-class)) ())
 
 (defmethod validate-superclass ((c class) (s built-in-class))
-  (eq s *the-class-t*))
+  (or (eq s *the-class-t*) #+cmu (eq s *the-class-stream*)))