Hi, Attached is a bugfix for #985 as I was able to reproduce it on my amd64 laptop. It's another bug introduced by my read-line fix, this time in the process read-line. The bug is pretty obvious once you look at it (see the commit message).
I'm unsure whether this is exactly the same bug Matt ran into (since he mentioned seeing it in 4.8.0.1 which doesn't contain the read-line changes), but this needs to be fixed regardless. Cheers, Peter -- http://www.more-magic.net
>From 82590a960df7ec4a25cfd2a032b1e617d92d10fa Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> 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
_______________________________________________ Chicken-hackers mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-hackers
