Changeset 5081

Timestamp:

Sep 3, 2006, 1:20:08 PM (18 years ago)

Author:

Gary Byers

Message:

More missing BASIC-STREAM methods.

File:

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

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

@@ -1415 +1415 @@
   (generic-character-read-vector stream vector start end))
 
+
 (defmethod stream-read-vector ((stream fundamental-binary-input-stream)
                                vector start end)
@@ -1425 +1426 @@
         (return i)
         (setf (uvref vector i) b)))))
+
+
 
 
@@ -1534 +1537 @@
   (apply #'make-ioblock :stream stream args))
 
+(defmethod stream-read-vector ((stream basic-character-input-stream)
+                               vector start end)
+  (generic-character-read-vector stream vector start end))
+
+(defmethod stream-read-vector ((stream basic-binary-input-stream)
+                               vector start end)
+  (declare (fixnum start end))
+  (do* ((i start (1+ i)))
+       ((= i end) end)
+    (declare (fixnum i))
+    (let* ((b (stream-read-byte stream)))
+      (if (eq b :eof)
+        (return i)
+        (setf (uvref vector i) b)))))
 
 (defun stream-is-closed (s)
@@ -2374 +2391 @@
   (with-stream-ioblock-input (ioblock stream :speedy t)
     (funcall (ioblock-read-byte-function ioblock) ioblock)))
+
+(defmethod stream-read-byte ((stream basic-binary-input-stream))
+  (let* ((ioblock (basic-stream-ioblock stream)))
+    (with-ioblock-input-locked (ioblock)
+      (funcall (ioblock-read-byte-function ioblock) ioblock))))
 
 (defmethod stream-eofp ((stream buffered-input-stream-mixin))
@@ -2600 +2622 @@
                  (%ioblock-force-output ioblock nil))))))))))
 
+(defmethod stream-write-vector ((stream basic-binary-output-stream)
+                                vector start end)
+  (declare (fixnum start end))
+  (let* ((ioblock (basic-stream-ioblock stream)))
+    (with-ioblock-output-locked (ioblock)
+    (let* ((out (ioblock-outbuf ioblock))
+           (buf (io-buffer-buffer out))
+           (written 0)
+           (limit (io-buffer-limit out))
+           (total (- end start))
+           (buftype (typecode buf)))
+      (declare (fixnum buftype written total limit))
+      (if (not (= (the fixnum (typecode vector)) buftype))
+        (do* ((i start (1+ i)))
+             ((= i end))
+          (let ((byte (uvref vector i)))
+            (when (characterp byte)
+              (setq byte (char-code byte)))
+            (%ioblock-write-byte ioblock byte)))
+        (do* ((pos start (+ pos written))
+              (left total (- left written)))
+             ((= left 0))
+          (declare (fixnum pos left))
+          (setf (ioblock-dirty ioblock) t)
+          (let* ((index (io-buffer-idx out))
+                 (count (io-buffer-count out))
+                 (avail (- limit index)))
+            (declare (fixnum index avail count))
+            (cond
+              ((= (setq written avail) 0)
+               (%ioblock-force-output ioblock nil))
+              (t
+               (if (> written left)
+                 (setq written left))
+               (%copy-ivector-to-ivector
+                vector
+                (ioblock-elements-to-octets ioblock pos)
+                buf
+                (ioblock-elements-to-octets ioblock index)
+                (ioblock-elements-to-octets ioblock written))
+               (setf (ioblock-dirty ioblock) t)
+               (incf index written)
+               (if (> index count)
+                 (setf (io-buffer-count out) index))
+               (setf (io-buffer-idx out) index)
+               (if (= index  limit)
+                 (%ioblock-force-output ioblock nil)))))))))))
+
+(defmethod stream-read-vector ((stream basic-character-input-stream)
+                               vector start end)
+  (declare (fixnum start end))
+  (if (not (typep vector 'simple-base-string))
+    (call-next-method)
+    (let* ((ioblock (basic-stream-ioblock stream)))
+      (with-ioblock-input-locked (ioblock)
+        (%ioblock-character-read-vector ioblock vector start end)))))
+
+(defmethod stream-read-vector ((stream basic-binary-input-stream)
+                               vector start end)
+  (declare (fixnum start end))
+  (if (typep vector 'simple-base-string)
+    (call-next-method)
+    (let* ((ioblock (basic-stream-ioblock stream)))
+      (with-ioblock-input-locked (ioblock)
+        (%ioblock-binary-read-vector ioblock vector start end)))))
+
 (defmethod stream-read-vector ((stream buffered-character-input-stream-mixin)
                                vector start end)
@@ -2608 +2696 @@
       (%ioblock-character-read-vector ioblock vector start end))))
 
+
+
 (defmethod stream-read-vector ((stream buffered-binary-input-stream-mixin)
                                vector start end)
@@ -2615 +2705 @@
     (with-stream-ioblock-input (ioblock stream :speedy t)
       (%ioblock-binary-read-vector ioblock vector start end))))
+
+
 
 (defloadvar *fd-set-size*