Index: /trunk/ccl/level-1/l1-sysio.lisp
===================================================================
--- /trunk/ccl/level-1/l1-sysio.lisp	(revision 4928)
+++ /trunk/ccl/level-1/l1-sysio.lisp	(revision 4929)
@@ -606,4 +606,24 @@
 	  'fundamental-file-stream)))))
 
+(defmethod map-to-basic-stream-class-name ((name (eql 'fundamental-file-stream)))
+  'basic-file-stream)
+
+(defmethod select-stream-class ((class (eql 'basic-file-stream)) in-p out-p char-p)
+  (if char-p
+    (if (and in-p out-p)
+      'basic-file-character-io-stream
+      (if in-p
+	'basic-file-character-input-stream
+	(if out-p
+	  'basic-file-character-output-stream
+	  'basic-file-stream)))
+    (if (and in-p out-p)
+      'basic-file-binary-io-stream
+      (if in-p
+	'basic-file-binary-input-stream
+	(if out-p
+	  'basic-file-binary-output-stream
+	  'basic-file-stream)))))
+
 (defun make-file-stream (filename
 			 direction
@@ -614,11 +634,12 @@
 			 class
 			 external-format
-                         sharing)
+                         sharing
+                         basic)
 
   (let* ((temp-name nil)
          (dir (pathname-directory filename))
          (filename (if (eq (car dir) :relative)
-                       (full-pathname filename)
-                       filename))
+                     (full-pathname filename)
+                     filename))
          (pathname (pathname filename))) 
     (block open
@@ -650,5 +671,5 @@
 		   (setq native-truename (%create-file filename)))
 		  ((memq direction '(:output :io))
-		   #| ;;
+		   #|;;
                    ;; this prevents us from writing a file that is open for anything            
                    ;;l but does not protect against reading a file that is open for :output
@@ -675,6 +696,11 @@
                               :element-type element-type
                               :elements-per-buffer elements-per-buffer
-                              :sharing sharing)
-              (let* ((in-p (member direction '(:io :input)))
+                              :sharing sharing
+                              :basic basic)
+              (progn
+                (when basic
+                  (setq class (map-to-basic-stream-class-name class))
+                  (setq basic (subtypep (find-class class) 'basic-stream)))
+                (let* ((in-p (member direction '(:io :input)))
                      (out-p (member direction '(:io :output)))
                      (io-p (eq direction :io))
@@ -737,5 +763,5 @@
                   (close fstream)
                   (push fstream *open-file-streams*))
-                fstream))))))))
+                fstream)))))))))
 
 (defmethod stream-external-format ((s fundamental-file-stream))