X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=contrib%2Fsb-simple-streams%2Fstrategy.lisp;h=ea3bfd9c9e3c087f5e983f912e45b6814588941b;hb=22aec7852f4861e5dab28cc0d619c24b62590dad;hp=f7e2eb3aa2e4998ed6d098f5c7d99a31d1dab0e5;hpb=ac85367426b222612311c5cf7b061ff89c64d825;p=sbcl.git

diff --git a/contrib/sb-simple-streams/strategy.lisp b/contrib/sb-simple-streams/strategy.lisp
index f7e2eb3..ea3bfd9 100644
--- a/contrib/sb-simple-streams/strategy.lisp
+++ b/contrib/sb-simple-streams/strategy.lisp
@@ -14,6 +14,7 @@
     (let* ((unread (sm last-char-read-size stream))
 	   (buffer (sm buffer stream)))
       (unless (zerop unread)
+        ;; Keep last read character at beginning of buffer
 	(buffer-copy buffer (- (sm buffer-ptr stream) unread) buffer 0 unread))
       (let ((bytes (device-read stream nil unread nil blocking)))
 	(declare (type fixnum bytes))
@@ -219,13 +220,12 @@
 		 (funcall (the (or symbol function) (svref ctrl code))
 			  stream character))
 	(return-from sc-write-char character))
-      (if (< ptr (sm buffer-ptr stream))
-	  (progn
-	    (setf (bref buffer ptr) code)
-	    (setf (sm buffpos stream) (1+ ptr)))
-	  (progn
-	    (sc-flush-buffer stream t)
-	    (setf ptr (sm buffpos stream))))))
+      ;; FIXME: Shouldn't this be buf-len, not buffer-ptr?
+      (unless (< ptr (sm buffer-ptr stream))
+        (sc-flush-buffer stream t)
+        (setf ptr (sm buffpos stream)))
+      (setf (bref buffer ptr) code)
+      (setf (sm buffpos stream) (1+ ptr))))
   character)
 
 (declaim (ftype j-write-chars-fn sc-write-chars))
@@ -248,13 +248,14 @@
 	(unless (and (< code 32) ctrl (svref ctrl code)
 		     (funcall (the (or symbol function) (svref ctrl code))
 			      stream char))
-	  (if (< ptr max)
-	      (progn
-		(setf (bref buffer ptr) code)
-		(incf ptr))
-	      (progn
-		(sc-flush-buffer stream t)
-		(setf ptr (sm buffpos stream)))))))))
+	  (unless (< ptr max)
+            ;; need to update buffpos before control leaves this
+            ;; function in any way
+            (setf (sm buffpos stream) ptr)
+            (sc-flush-buffer stream t)
+            (setf ptr (sm buffpos stream)))
+          (setf (bref buffer ptr) code)
+          (incf ptr))))))
 
 (declaim (ftype j-listen-fn sc-listen))
 (defun sc-listen (stream)
@@ -373,13 +374,13 @@
 		 (funcall (the (or symbol function) (svref ctrl code))
 			  stream character))
 	(return-from dc-write-char character))
-      (if (< ptr (sm max-out-pos stream))
-	  (progn
-	    (setf (bref buffer ptr) code)
-	    (setf (sm outpos stream) (1+ ptr)))
-	  (progn
-	    (dc-flush-buffer stream t)
-	    (setf ptr (sm outpos stream))))))
+      (unless (< ptr (sm max-out-pos stream))
+        (dc-flush-buffer stream t)
+        (setf ptr (sm outpos stream)))
+      (progn
+        (setf (bref buffer ptr) code)
+        (setf (sm outpos stream) (1+ ptr))
+        )))
   character)
 
 (declaim (ftype j-write-chars-fn dc-write-chars))
@@ -398,13 +399,13 @@
 	(unless (and (< code 32) ctrl (svref ctrl code)
 		     (funcall (the (or symbol function) (svref ctrl code))
 			      stream char))
-	  (if (< ptr max)
-	      (progn
-		(setf (bref buffer ptr) code)
-		(incf ptr))
-	      (progn
-		(dc-flush-buffer stream t)
-		(setf ptr (sm outpos stream)))))))))
+	  (unless (< ptr max)
+            (setf (sm outpos stream) ptr)
+            (dc-flush-buffer stream t)
+            (setf ptr (sm outpos stream)))
+          (setf (bref buffer ptr) code)
+          (incf ptr))
+        ))))
 
 (declaim (ftype j-listen-fn dc-listen))
 (defun dc-listen (stream)