0.9.1.51:

[sbcl.git] / src / code / stream.lisp

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index d9d1b06..d658516 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -115,6 +115,9 @@
 (defun stream-element-type (stream)
   (ansi-stream-element-type stream))
 
+(defun stream-external-format (stream)
+  (funcall (ansi-stream-misc stream) stream :external-format))
+
 (defun interactive-stream-p (stream)
   (declare (type stream stream))
   (funcall (ansi-stream-misc stream) stream :interactive-p))
@@ -201,8 +204,18 @@
   ;; cause cross-compiler hangup.
   ;;
   ;; (declare (type (or file-stream synonym-stream) stream))
-  (stream-must-be-associated-with-file stream)
+  ;; 
+  ;; The description for FILE-LENGTH says that an error must be raised
+  ;; for streams not associated with files (which broadcast streams
+  ;; aren't according to the glossary). However, the behaviour of
+  ;; FILE-LENGTH for broadcast streams is explicitly described in the
+  ;; BROADCAST-STREAM entry.
+  (unless (typep stream 'broadcast-stream)           
+    (stream-must-be-associated-with-file stream))
   (funcall (ansi-stream-misc stream) stream :file-length))
+
+(defun file-string-length (stream object)
+  (funcall (ansi-stream-misc stream) stream :file-string-length object))
 \f
 ;;;; input functions
 
@@ -453,7 +466,7 @@
                          (find 'character
                                sb!vm:*specialized-array-element-type-properties*
                                :key #'sb!vm:saetp-specifier)))
-                       (bash-function (intern (format nil "UB~A-BASH-COPY" n-character-array-bits)
+                       (bash-function (intern (format nil "UB~D-BASH-COPY" n-character-array-bits)
                                               (find-package "SB!KERNEL"))))
                   bash-function)
                 ibuf +ansi-stream-in-buffer-extra+
@@ -618,6 +631,8 @@
      (finish-output stream))
     (:element-type
      (stream-element-type stream))
+    (:stream-external-format
+     (stream-external-format stream))
     (:interactive-p
      (interactive-stream-p stream))
     (:line-length
@@ -626,6 +641,8 @@
      (charpos stream))
     (:file-length
      (file-length stream))
+    (:file-string-length
+     (file-string-length stream arg1))
     (:file-position
      (file-position stream arg1))))
 \f
@@ -693,6 +710,15 @@
             ((null streams) res)
           (when (null (cdr streams))
             (setq res (stream-element-type (car streams)))))))
+      (:external-format
+       (let ((res :default))
+        (dolist (stream streams res)
+          (setq res (stream-external-format stream)))))
+      (:file-length
+       (let ((last (last streams)))
+        (if last            
+            (file-length (car last))
+            0)))
       (:file-position
        (if arg1
           (let ((res (or (eql arg1 :start) (eql arg1 0))))
@@ -701,6 +727,10 @@
           (let ((res 0))
             (dolist (stream streams res)
               (setq res (file-position stream))))))
+      (:file-string-length
+       (let ((res 1))
+        (dolist (stream streams res)
+          (setq res (file-string-length stream arg1)))))
       (:close
        (set-closed-flame stream))
       (t
@@ -1795,20 +1825,32 @@
                  (ansi-stream-bout stream))))
         (do ((rem (nthcdr start seq) (rest rem))
              (i start (1+ i)))
-            ((or (endp rem) (>= i end)) seq)
+            ((or (endp rem) (>= i end)))
           (declare (type list rem)
                    (type index i))
           (funcall write-function stream (first rem)))))
       (string
        (%write-string seq stream start end))
       (vector
-       (let ((write-function
-             (if (subtypep (stream-element-type stream) 'character)
-                 (ansi-stream-out stream)
-                 (ansi-stream-bout stream))))
-        (do ((i start (1+ i)))
-            ((>= i end) seq)
-          (declare (type index i))
-          (funcall write-function stream (aref seq i))))))))
+       (with-array-data ((data seq) (offset-start start) (offset-end end))
+        (labels
+            ((output-seq-in-loop ()
+               (let ((write-function
+                      (if (subtypep (stream-element-type stream) 'character)
+                          (ansi-stream-out stream)
+                          (ansi-stream-bout stream))))
+                 (do ((i offset-start (1+ i)))
+                     ((>= i offset-end))
+                   (declare (type index i))
+                   (funcall write-function stream (aref data i))))))
+          (typecase data
+            ((or (simple-array (unsigned-byte 8) (*))
+                 (simple-array (signed-byte 8) (*)))
+             (if (fd-stream-p stream)
+                 (output-raw-bytes stream data offset-start offset-end)
+                 (output-seq-in-loop)))
+            (t
+             (output-seq-in-loop))))))))
+  seq)
 \f
 ;;;; etc.