Changeset 4929

Timestamp:

Jul 29, 2006, 5:26:35 AM (18 years ago)

Author:

Gary Byers

Message:

MAKE-FILE-STREAM: support for BASIC-STREAMs.

File:

• trunk/ccl/level-1/l1-sysio.lisp (modified) (5 diffs)

trunk/ccl/level-1/l1-sysio.lisp

@@ -606 +606 @@
           '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 +634 @@
                          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 +671 @@
                    (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 +696 @@
                               :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 +763 @@
                   (close fstream)
                   (push fstream *open-file-streams*))
-                fstream))))))))
+                fstream)))))))))
 
 (defmethod stream-external-format ((s fundamental-file-stream))