1.0.12.5: WITH-ARRAY-DATA touchups

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

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index adec888..799e242 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -150,6 +150,8 @@
   (declare (type stream stream))
   (declare (type (or index (alien sb!unix:off-t) (member nil :start :end))
                  position))
+  ;; FIXME: It woud be good to comment on the stuff that is done here...
+  ;; FIXME: This doesn't look interrupt safe.
   (cond
     (position
      (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+)
@@ -570,12 +572,11 @@
   (declare (type string string))
   (declare (type ansi-stream stream))
   (declare (type index start end))
-  (if (array-header-p string)
-      (with-array-data ((data string) (offset-start start)
-                        (offset-end end))
-        (funcall (ansi-stream-sout stream)
-                 stream data offset-start offset-end))
-      (funcall (ansi-stream-sout stream) stream string start end))
+  (with-array-data ((data string) (offset-start start)
+                    (offset-end end)
+                    :check-fill-pointer t)
+    (funcall (ansi-stream-sout stream)
+             stream data offset-start offset-end))
   string)
 
 (defun %write-string (string stream start end)
@@ -1134,14 +1135,14 @@
             (truly-the index (+ index copy)))
       ;; FIXME: why are we VECTOR-SAP'ing things here?  what's the point?
       ;; and are there SB-UNICODE issues here as well?  --njf, 2005-03-24
-      (without-gcing
-       (system-area-ub8-copy (vector-sap string)
-                             index
-                             (if (typep buffer 'system-area-pointer)
-                                 buffer
-                                 (vector-sap buffer))
-                             start
-                             copy)))
+      (with-pinned-objects (string buffer)
+        (system-area-ub8-copy (vector-sap string)
+                              index
+                              (if (typep buffer 'system-area-pointer)
+                                  buffer
+                                  (vector-sap buffer))
+                              start
+                              copy)))
     (if (and (> requested copy) eof-error-p)
         (error 'end-of-file :stream stream)
         copy)))
@@ -1179,8 +1180,8 @@
   (declare (type string string)
            (type index start)
            (type (or index null) end))
-  (let* ((string (coerce string '(simple-array character (*))))
-         (end (%check-vector-sequence-bounds string start end)))
+  (let* ((string (coerce string '(simple-array character (*)))))
+    ;; FIXME: Why WITH-ARRAY-DATA, since the array is already simple?
     (with-array-data ((string string) (start start) (end end))
       (internal-make-string-input-stream
        string ;; now simple
@@ -1225,8 +1226,8 @@
   ;; Global location in the stream
   (index 0 :type index)
   ;; Index cache: when we move backwards we save the greater of this
-  ;; and index here, so the the greater of index and this is always
-  ;; the end of the stream.
+  ;; and index here, so the greater of index and this is always the
+  ;; end of the stream.
   (index-cache 0 :type index)
   ;; Requested element type
   (element-type 'character))
@@ -1967,7 +1968,8 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
                (return i))
              (setf (first rem) el)))))
       (vector
-       (with-array-data ((data seq) (offset-start start) (offset-end end))
+       (with-array-data ((data seq) (offset-start start) (offset-end end)
+                         :check-fill-pointer t)
          (if (compatible-vector-and-stream-element-types-p data stream)
              (let* ((numbytes (- end start))
                     (bytes-read (read-n-bytes stream data offset-start
@@ -2034,7 +2036,8 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
       (string
        (%write-string seq stream start end))
       (vector
-       (with-array-data ((data seq) (offset-start start) (offset-end end))
+       (with-array-data ((data seq) (offset-start start) (offset-end end)
+                         :check-fill-pointer t)
          (labels
              ((output-seq-in-loop ()
                 (let ((write-function
@@ -2056,7 +2059,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
                     (funcall write-function stream (aref data i))))))
            (if (and (fd-stream-p stream)
                     (compatible-vector-and-stream-element-types-p data stream))
-               (output-raw-bytes stream data offset-start offset-end)
+               (buffer-output stream data offset-start offset-end)
                (output-seq-in-loop)))))))
   seq)
 \f