From: Rudi Schlatte <rudi@constantly.at>
Date: Sun, 15 May 2005 20:09:56 +0000 (+0000)
Subject: 0.9.0.34
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=07216cc60fa30d07a8b62a879e16aff79c60a43d;p=sbcl.git

0.9.0.34
Eliminate unnecessary seeks on socket streams
  ... Introduce dual-channel-p flag in fd-streams to discriminate
      between files and socket/pipe-streams
---

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 4a5249f..06ca1e3 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -268,6 +268,7 @@ SB-SYS:MAKE-FD-STREAM."))
       (setf stream (apply #'sb-sys:make-fd-stream
 			  (socket-file-descriptor socket)
 			  :name "a constant string"
+			  :dual-channel-p t
 			  args))
       (setf (slot-value socket 'stream) stream)
       (sb-ext:cancel-finalization socket))
diff --git a/contrib/sb-simple-streams/internal.lisp b/contrib/sb-simple-streams/internal.lisp
index a74aabb..659f2db 100644
--- a/contrib/sb-simple-streams/internal.lisp
+++ b/contrib/sb-simple-streams/internal.lisp
@@ -638,6 +638,7 @@
                                   :original original
                                   :delete-original delete-original
                                   :pathname pathname
+				  :dual-channel-p nil
                                   :input-buffer-p t
                                   :auto-close t))
           (:probe
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index caa363d..1d8b567 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -57,6 +57,11 @@
   (fd -1 :type fixnum)	      
   ;; controls when the output buffer is flushed
   (buffering :full :type (member :full :line :none))
+  ;; controls whether the input buffer must be cleared before output
+  ;; (must be done for files, not for sockets, pipes and other data
+  ;; sources where input and output aren't related).  non-NIL means
+  ;; don't clear input buffer.
+  (dual-channel-p nil)
   ;; character position (if known)
   (char-pos nil :type (or index null))
   ;; T if input is waiting on FD. :EOF if we hit EOF.
@@ -244,8 +249,9 @@
 		       size))
             (flush-output-buffer ,stream-var)))
       ,(unless (eq (car buffering) :none)
-	 `(when (> (fd-stream-ibuf-tail ,stream-var)
-		   (fd-stream-ibuf-head ,stream-var))
+	 `(when (and (not (fd-stream-dual-channel-p ,stream-var))
+		     (> (fd-stream-ibuf-tail ,stream-var)
+			(fd-stream-ibuf-head ,stream-var)))
             (file-position ,stream-var (file-position ,stream-var))))
       ,(if restart
            `(catch 'output-nothing
@@ -272,8 +278,9 @@
 		       ,size))
             (flush-output-buffer ,stream-var)))
       ,(unless (eq (car buffering) :none)
-	 `(when (> (fd-stream-ibuf-tail ,stream-var)
-		   (fd-stream-ibuf-head ,stream-var))
+	 `(when (and (not (fd-stream-dual-channel-p ,stream-var))
+		     (> (fd-stream-ibuf-tail ,stream-var)
+			(fd-stream-ibuf-head ,stream-var)))
             (file-position ,stream-var (file-position ,stream-var))))
       ,(if restart
 	   `(catch 'output-nothing
@@ -419,8 +426,9 @@
   (let ((start (or start 0))
 	(end (or end (length (the (simple-array * (*)) thing)))))
     (declare (type index start end))
-    (when (> (fd-stream-ibuf-tail fd-stream)
-	     (fd-stream-ibuf-head fd-stream))
+    (when (and (not (fd-stream-dual-channel-p fd-stream))
+	       (> (fd-stream-ibuf-tail fd-stream)
+		  (fd-stream-ibuf-head fd-stream)))
       (file-position fd-stream (file-position fd-stream)))
     (let* ((len (fd-stream-obuf-length fd-stream))
 	   (tail (fd-stream-obuf-tail fd-stream))
@@ -963,8 +971,9 @@
 	(let ((start (or start 0))
 	      (end (or end (length string))))
 	  (declare (type index start end))
-	  (when (> (fd-stream-ibuf-tail stream)
-		   (fd-stream-ibuf-head stream))
+	  (when (and (not (fd-stream-dual-channel-p stream))
+		     (> (fd-stream-ibuf-tail stream)
+			(fd-stream-ibuf-head stream)))
 	    (file-position stream (file-position stream)))
 	  (when (< end start)
 	    (error ":END before :START!"))
@@ -1065,8 +1074,9 @@
 	(let ((start (or start 0))
 	      (end (or end (length string))))
 	  (declare (type index start end))
-	  (when (> (fd-stream-ibuf-tail fd-stream)
-		   (fd-stream-ibuf-head fd-stream))
+	  (when (and (not (fd-stream-dual-channel-p fd-stream))
+		     (> (fd-stream-ibuf-tail fd-stream)
+			(fd-stream-ibuf-head fd-stream)))
 	    (file-position fd-stream (file-position fd-stream)))
 	  (when (< end start)
 	    (error ":END before :START!"))
@@ -1726,6 +1736,7 @@
 		       delete-original
 		       pathname
 		       input-buffer-p
+		       dual-channel-p
 		       (name (if file
 				 (format nil "file ~S" file)
 				 (format nil "descriptor ~W" fd)))
@@ -1743,6 +1754,7 @@
 				 :delete-original delete-original
 				 :pathname pathname
 				 :buffering buffering
+				 :dual-channel-p dual-channel-p
 				 :external-format external-format
 				 :timeout timeout)))
     (set-fd-stream-routines stream element-type input output input-buffer-p)
@@ -1936,6 +1948,7 @@
 				      :original original
 				      :delete-original delete-original
 				      :pathname pathname
+				      :dual-channel-p nil
 				      :input-buffer-p t
 				      :auto-close t))
 		     (:probe
diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 25c31c2..ab9ebf7 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -320,7 +320,8 @@
 	  (push new-fd *close-on-error*)
 	  (copy-descriptor-to-stream new-fd pty cookie)))
       (values name
-	      (sb-sys:make-fd-stream master :input t :output t)))))
+	      (sb-sys:make-fd-stream master :input t :output t 
+				     :dual-channel-p t)))))
 
 (defmacro round-bytes-to-words (n)
   `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index fe34aac..b3285a9 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -392,13 +392,13 @@ interactive."
     (labels ((thread-repl () 
 	       (sb!unix::unix-setsid)
 	       (let* ((sb!impl::*stdin* 
-		       (sb!sys:make-fd-stream in :input t :buffering :line))
+		       (sb!sys:make-fd-stream in :input t :buffering :line :dual-channel-p t))
 		      (sb!impl::*stdout* 
-		       (sb!sys:make-fd-stream out :output t :buffering :line))
+		       (sb!sys:make-fd-stream out :output t :buffering :line :dual-channel-p t))
 		      (sb!impl::*stderr* 
-		       (sb!sys:make-fd-stream err :output t :buffering :line))
+		       (sb!sys:make-fd-stream err :output t :buffering :line :dual-channel-p t))
 		      (sb!impl::*tty* 
-		       (sb!sys:make-fd-stream err :input t :output t :buffering :line))
+		       (sb!sys:make-fd-stream err :input t :output t :buffering :line :dual-channel-p t))
 		      (sb!impl::*descriptor-handlers* nil))
 		 (with-new-session ()
 		   (sb!sys:enable-interrupt sb!unix:sigint #'sb!unix::sigint-handler)
diff --git a/version.lisp-expr b/version.lisp-expr
index 8847cfc..3fd4f02 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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.33"
+"0.9.0.34"