Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28341/src/code

Modified Files:
	stream.lisp 
Log Message:
Fix bug 242 for fd-streams
  ... fd-streams have a method that writes n octets; use it.


Index: stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/stream.lisp,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -d -r1.76 -r1.77
--- stream.lisp	16 May 2005 12:19:33 -0000	1.76
+++ stream.lisp	16 May 2005 19:40:08 -0000	1.77
@@ -1795,20 +1795,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)
 
 ;;;; etc.

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4744

Modified Files:
	version.lisp-expr 
Log Message:
0.9.0.35
Slight depessimization of WRITE-SEQUENCE of byte arrays
  ... Don't go through full stream dispatch machinery for every byte


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2137
retrieving revision 1.2138
diff -u -d -r1.2137 -r1.2138
--- version.lisp-expr	15 May 2005 20:09:57 -0000	1.2137
+++ version.lisp-expr	16 May 2005 12:19:33 -0000	1.2138
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.0.34"
+"0.9.0.35"

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4744/src/code

Modified Files:
	stream.lisp 
Log Message:
0.9.0.35
Slight depessimization of WRITE-SEQUENCE of byte arrays
  ... Don't go through full stream dispatch machinery for every byte


Index: stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/stream.lisp,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -d -r1.75 -r1.76
--- stream.lisp	2 May 2005 16:32:37 -0000	1.75
+++ stream.lisp	16 May 2005 12:19:33 -0000	1.76
@@ -1791,30 +1791,24 @@
       (list
        (let ((write-function
 	      (if (subtypep (stream-element-type stream) 'character)
-                  ;; FIXME (rudi 2004-08-09): since we know we're an
-                  ;; ansi stream here, we could replace these
-                  ;; functions with ansi-stream-specific constructs
-		  #'write-char
-		  #'write-byte)))
+		  (ansi-stream-out stream)
+		  (ansi-stream-bout stream))))
 	 (do ((rem (nthcdr start seq) (rest rem))
 	      (i start (1+ i)))
 	     ((or (endp rem) (>= i end)) seq)
 	   (declare (type list rem)
 		    (type index i))
-	   (funcall write-function (first rem) stream))))
+	   (funcall write-function stream (first rem)))))
       (string
        (%write-string seq stream start end))
       (vector
        (let ((write-function
 	      (if (subtypep (stream-element-type stream) 'character)
-                  ;; FIXME (rudi 2004-08-09): since we know we're an
-                  ;; ansi stream here, we could replace these
-                  ;; functions with ansi-specific constructs
-		  #'write-char
-		  #'write-byte)))
+		  (ansi-stream-out stream)
+		  (ansi-stream-bout stream))))
 	 (do ((i start (1+ i)))
 	     ((>= i end) seq)
 	   (declare (type index i))
-	   (funcall write-function (aref seq i) stream)))))))
+	   (funcall write-function stream (aref seq i))))))))
 
 ;;;; etc.