>From 82590a960df7ec4a25cfd2a032b1e617d92d10fa Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Wed, 20 Feb 2013 22:19:07 +0100
Subject: [PATCH] Fix #985 by making process ports consistent with TCP ports.

This causes it to call "fetch" only when more data is requested than available in the buffer, instead of always calling "fetch" and checking inside the procedure whether we need more data.

The bug was due to the fact that fetch checked the position was at the end of the buffer, but it wasn't since ##sys#scan-buffer-line and the posix eos-handler doesn't advance the position while reading (only afterwards, assuming "fetch" would reset the position).
---
 posixunix.scm | 81 +++++++++++++++++++++++++++++------------------------------
 1 file changed, 40 insertions(+), 41 deletions(-)

diff --git a/posixunix.scm b/posixunix.scm
index 650d2c3..6d1fe51 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1318,40 +1318,38 @@ EOF
 		   (##core#inline "C_subchar" buf bufpos)) )]
             [fetch
 	     (lambda ()
-	       (when (fx>= bufpos buflen)
-		 (let loop ()
-		   (let ([cnt (##core#inline "C_read" fd buf bufsiz)])
-		     (cond ((fx= cnt -1)
-			    (select _errno
-			      ((_ewouldblock _eagain)
-			       (##sys#thread-block-for-i/o! ##sys#current-thread fd #:input)
-			       (##sys#thread-yield!)
-			       (loop) )
-			      ((_eintr)
-			       (##sys#dispatch-interrupt loop))
-			      (else (posix-error #:file-error loc "cannot read" fd nam) )))
-			   [(and more? (fx= cnt 0))
-					; When "more" keep trying, otherwise read once more
-					; to guard against race conditions
-			    (if (more?)
-				(begin
-				  (##sys#thread-yield!)
-				  (loop) )
-				(let ([cnt (##core#inline "C_read" fd buf bufsiz)])
-				  (when (fx= cnt -1)
-				    (if (or (fx= _errno _ewouldblock)
-					    (fx= _errno _eagain))
-					(set! cnt 0)
-					(posix-error #:file-error loc "cannot read" fd nam) ) )
-				  (set! buflen cnt)
-				  (set! bufpos 0) ) )]
-			   [else
-			    (set! buflen cnt)
-			    (set! bufpos 0)]) ) ) ) )] )
+	       (let loop ()
+		 (let ([cnt (##core#inline "C_read" fd buf bufsiz)])
+		   (cond ((fx= cnt -1)
+			  (select _errno
+			    ((_ewouldblock _eagain)
+			     (##sys#thread-block-for-i/o! ##sys#current-thread fd #:input)
+			     (##sys#thread-yield!)
+			     (loop) )
+			    ((_eintr)
+			     (##sys#dispatch-interrupt loop))
+			    (else (posix-error #:file-error loc "cannot read" fd nam) )))
+			 [(and more? (fx= cnt 0))
+			  ;; When "more" keep trying, otherwise read once more
+			  ;; to guard against race conditions
+			  (if (more?)
+			      (begin
+				(##sys#thread-yield!)
+				(loop) )
+			      (let ([cnt (##core#inline "C_read" fd buf bufsiz)])
+				(when (fx= cnt -1)
+				  (if (or (fx= _errno _ewouldblock)
+					  (fx= _errno _eagain))
+				      (set! cnt 0)
+				      (posix-error #:file-error loc "cannot read" fd nam) ) )
+				(set! buflen cnt)
+				(set! bufpos 0) ) )]
+			 [else
+			  (set! buflen cnt)
+			  (set! bufpos 0)]) ) )	 )] )
 	(letrec ([this-port
 		  (make-input-port
 		   (lambda ()		; read-char
-		     (fetch)
 		     (let ([ch (peek)])
 		       #; ; Allow increment since overflow is far, far away
 		       (unless (eof-object? ch) (set! bufpos (fx+ bufpos 1)))
@@ -1367,22 +1365,23 @@ EOF
 			 (posix-error #:file-error loc "cannot close" fd nam) )
 		       (on-close) ) )
 		   (lambda ()		; peek-char
-		     (fetch)
+		     (when (fx>= bufpos buflen)
+		       (fetch))
 		     (peek) )
 		   (lambda (port n dest start) ; read-string!
 		     (let loop ([n (or n (fx- (##sys#size dest) start))] [m 0] [start start])
 		       (cond [(eq? 0 n) m]
 			     [(fx< bufpos buflen)
-                              (let* ([rest (fx- buflen bufpos)]
-                                     [n2 (if (fx< n rest) n rest)])
-                                (##core#inline "C_substring_copy" buf dest bufpos (fx+ bufpos n2) start)
-                                (set! bufpos (fx+ bufpos n2))
-                                (loop (fx- n n2) (fx+ m n2) (fx+ start n2)) ) ]
+			      (let* ([rest (fx- buflen bufpos)]
+				     [n2 (if (fx< n rest) n rest)])
+				(##core#inline "C_substring_copy" buf dest bufpos (fx+ bufpos n2) start)
+				(set! bufpos (fx+ bufpos n2))
+				(loop (fx- n n2) (fx+ m n2) (fx+ start n2)) ) ]
 			     [else
-                              (fetch)
-                              (if (eq? 0 buflen) 
-                                  m
-                                  (loop n m start) ) ] ) ) )
+			      (fetch)
+			      (if (eq? 0 buflen) 
+				  m
+				  (loop n m start) ) ] ) ) )
 		   (lambda (port limit)	; read-line
 		     (when (fx>= bufpos buflen)
 		       (fetch))
-- 
1.8.0.1