Changeset 5580

Timestamp:

Dec 3, 2006, 6:41:24 AM (18 years ago)

Author:

Gary Byers

Message:

FORCE-OUTPUT, FINISH-OUTPUT on STRING-OUTPUT-STREAMs are no-ops.

Need an ioblock-based character-read-vector function for
string-input-streams.

File:

• trunk/ccl/level-1/l1-streams.lisp (modified) (3 diffs)

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

@@ -4083 +4083 @@
 (def-standard-initial-binding %string-output-stream-ioblocks% (%cons-pool nil))
 
+(defmethod stream-force-output ((s string-output-stream))
+  nil)
+
+(defmethod stream-finish-output ((s string-output-stream))
+  nil)
+
 ;;; Should only be used for a stream whose class is exactly
 ;;; *string-output-stream-class* 
@@ -4468 +4474 @@
 
 
+(defun string-input-stream-character-read-vector (ioblock vector start end)
+  (let* ((string (string-stream-ioblock-string ioblock))
+         (idx (string-input-stream-ioblock-index ioblock))
+         (limit (string-input-stream-ioblock-end ioblock)))
+    (declare (fixnum idx limit))
+    (do* ((i start (1+ i)))
+         ((= i end) (setf (string-input-stream-ioblock-index ioblock) idx) end)
+      (declare (fixnum i))
+      (if (< idx limit)
+        (setf (uvref vector i) (schar string idx)
+              idx (1+ idx))
+        (progn
+          (setf (string-input-stream-ioblock-index ioblock) idx)
+          (return i))))))
+         
+
+
 (defun make-string-input-stream (string &optional (start 0)
                                         (end nil))
@@ -4491 +4514 @@
                      :read-char-when-locked-function 'string-input-stream-ioblock-read-char
                      :peek-char-function 'string-input-stream-ioblock-peek-char
-                     :character-read-vector-function 'generic-character-read-vector
+                     :character-read-vector-function 'string-input-stream-character-read-vector
                      :close-function #'false
                      :unread-char-function 'string-input-stream-ioblock-unread-char