Steel Bank Common Lisp

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

Modified Files:
	target-stream.lisp fd-stream.lisp 
Log Message:
0.9.1.3
Small stream cleanups:
  - Use same names in generalized-peeking-mechanism as cmucl
  - set-fd-stream-routines can now in theory be used to change stream
    element-type and external-format (but this clashes with
    fast-read-char/-byte, since these work off another layer of buffers)


Index: target-stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-stream.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- target-stream.lisp	20 May 2005 16:43:21 -0000	1.4
+++ target-stream.lisp	29 May 2005 10:27:38 -0000	1.5
@@ -27,32 +27,32 @@
 ;;; EOF-DETECTED-FORM - the form to execute when EOF has been detected
 ;;;                     (this will default to EOF-RESULT)
 (sb!xc:defmacro generalized-peeking-mechanism
-    (peek-type eof-result char-var read-form eof-value unread-form
+    (peek-type eof-value char-var read-form read-eof unread-form
      &optional (skipped-char-form nil) (eof-detected-form nil))
   `(let ((,char-var ,read-form))
-    (cond ((eql ,char-var ,eof-value)
+    (cond ((eql ,char-var ,read-eof)
            ,(if eof-detected-form
                 eof-detected-form
-                eof-result))
+                eof-value))
           ((characterp ,peek-type)
            (do ((,char-var ,char-var ,read-form))
-               ((or (eql ,char-var ,eof-value) 
+               ((or (eql ,char-var ,read-eof) 
                     (char= ,char-var ,peek-type))
-                (cond ((eql ,char-var ,eof-value)
+                (cond ((eql ,char-var ,read-eof)
                        ,(if eof-detected-form
                             eof-detected-form
-                            eof-result))
+                            eof-value))
                       (t ,unread-form
                          ,char-var)))
              ,skipped-char-form))
           ((eql ,peek-type t)
            (do ((,char-var ,char-var ,read-form))
-               ((or (eql ,char-var ,eof-value)
+               ((or (eql ,char-var ,read-eof)
                     (not (whitespacep ,char-var)))
-                (cond ((eql ,char-var ,eof-value)
+                (cond ((eql ,char-var ,read-eof)
                        ,(if eof-detected-form
                             eof-detected-form
-                            eof-result))
+                            eof-value))
                       (t ,unread-form
                          ,char-var)))
              ,skipped-char-form))

Index: fd-stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -d -r1.72 -r1.73
--- fd-stream.lisp	19 May 2005 02:50:40 -0000	1.72
+++ fd-stream.lisp	29 May 2005 10:27:38 -0000	1.73
@@ -1345,10 +1345,11 @@
 	(output-size nil)
 	(character-stream-p (subtypep type 'character)))
 
-    (when (fd-stream-obuf-sap fd-stream)
+    ;; drop buffers when direction changes
+    (when (and (fd-stream-obuf-sap fd-stream) (not output-p))
       (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
       (setf (fd-stream-obuf-sap fd-stream) nil))
-    (when (fd-stream-ibuf-sap fd-stream)
+    (when (and (fd-stream-ibuf-sap fd-stream) (not input-p))
       (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
       (setf (fd-stream-ibuf-sap fd-stream) nil))
 
@@ -1387,9 +1388,6 @@
                 normalized-external-format))
 	(unless routine
 	  (error "could not find any input routine for ~S" target-type))
-	(setf (fd-stream-ibuf-sap fd-stream) (next-available-buffer))
-	(setf (fd-stream-ibuf-length fd-stream) bytes-per-buffer)
-	(setf (fd-stream-ibuf-tail fd-stream) 0)
 	(if character-stream-p
 	    (setf (fd-stream-in fd-stream) routine
 		  (fd-stream-bin fd-stream) #'ill-bin)
@@ -1434,9 +1432,6 @@
 	  (error "could not find any output routine for ~S buffered ~S"
 		 (fd-stream-buffering fd-stream)
 		 target-type))
-	(setf (fd-stream-obuf-sap fd-stream) (next-available-buffer))
-	(setf (fd-stream-obuf-length fd-stream) bytes-per-buffer)
-	(setf (fd-stream-obuf-tail fd-stream) 0)
 	(when character-stream-p
 	  (setf (fd-stream-output-bytes fd-stream) output-bytes))
 	(if character-stream-p
@@ -1450,7 +1445,6 @@
 		(fd-stream-bout fd-stream) routine))
 	(setf (fd-stream-sout fd-stream)
 	      (if (eql size 1) #'fd-sout #'ill-out))
-	(setf (fd-stream-char-pos fd-stream) 0)
 	(setf output-size size)
 	(setf output-type type)))
 
@@ -1765,6 +1759,15 @@
 				 :dual-channel-p dual-channel-p
 				 :external-format external-format
 				 :timeout timeout)))
+    (when input
+      (setf (fd-stream-ibuf-sap stream) (next-available-buffer))
+      (setf (fd-stream-ibuf-length stream) bytes-per-buffer)
+      (setf (fd-stream-ibuf-tail stream) 0))
+    (when output
+      (setf (fd-stream-obuf-sap stream) (next-available-buffer))
+      (setf (fd-stream-obuf-length stream) bytes-per-buffer)
+      (setf (fd-stream-obuf-tail stream) 0)
+      (setf (fd-stream-char-pos stream) 0))
     (set-fd-stream-routines stream element-type input output input-buffer-p)
     (when (and auto-close (fboundp 'finalize))
       (finalize stream