Ticket #985: 0001-Fix-985-by-making-process-ports-consistent-with-TCP-.patch

File 0001-Fix-985-by-making-process-ports-consistent-with-TCP-.patch, 4.6 KB (added by sjamaan, 11 years ago)

A fix against master

  • posixunix.scm 

    From 82590a960df7ec4a25cfd2a032b1e617d92d10fa Mon Sep 17 00:00:00 2001
From: Peter Bex <peter.bex@xs4all.nl>
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 b EOF 
    13181318                   (##core#inline "C_subchar" buf bufpos)) )]
    13191319            [fetch
    13201320             (lambda ()
    1321                (when (fx>= bufpos buflen)
    1322                  (let loop ()
    1323                    (let ([cnt (##core#inline "C_read" fd buf bufsiz)])
    1324                      (cond ((fx= cnt -1)
    1325                             (select _errno
    1326                               ((_ewouldblock _eagain)
    1327                                (##sys#thread-block-for-i/o! ##sys#current-thread fd #:input)
    1328                                (##sys#thread-yield!)
    1329                                (loop) )
    1330                               ((_eintr)
    1331                                (##sys#dispatch-interrupt loop))
    1332                               (else (posix-error #:file-error loc "cannot read" fd nam) )))
    1333                            [(and more? (fx= cnt 0))
    1334                                         ; When "more" keep trying, otherwise read once more
    1335                                         ; to guard against race conditions
    1336                             (if (more?)
    1337                                 (begin
    1338                                   (##sys#thread-yield!)
    1339                                   (loop) )
    1340                                 (let ([cnt (##core#inline "C_read" fd buf bufsiz)])
    1341                                   (when (fx= cnt -1)
    1342                                     (if (or (fx= _errno _ewouldblock)
    1343                                             (fx= _errno _eagain))
    1344                                         (set! cnt 0)
    1345                                         (posix-error #:file-error loc "cannot read" fd nam) ) )
    1346                                   (set! buflen cnt)
    1347                                   (set! bufpos 0) ) )]
    1348                            [else
    1349                             (set! buflen cnt)
    1350                             (set! bufpos 0)]) ) ) ) )] )
     1321               (let loop ()
     1322                 (let ([cnt (##core#inline "C_read" fd buf bufsiz)])
     1323                   (cond ((fx= cnt -1)
     1324                          (select _errno
     1325                            ((_ewouldblock _eagain)
     1326                             (##sys#thread-block-for-i/o! ##sys#current-thread fd #:input)
     1327                             (##sys#thread-yield!)
     1328                             (loop) )
     1329                            ((_eintr)
     1330                             (##sys#dispatch-interrupt loop))
     1331                            (else (posix-error #:file-error loc "cannot read" fd nam) )))
     1332                         [(and more? (fx= cnt 0))
     1333                          ;; When "more" keep trying, otherwise read once more
     1334                          ;; to guard against race conditions
     1335                          (if (more?)
     1336                              (begin
     1337                                (##sys#thread-yield!)
     1338                                (loop) )
     1339                              (let ([cnt (##core#inline "C_read" fd buf bufsiz)])
     1340                                (when (fx= cnt -1)
     1341                                  (if (or (fx= _errno _ewouldblock)
     1342                                          (fx= _errno _eagain))
     1343                                      (set! cnt 0)
     1344                                      (posix-error #:file-error loc "cannot read" fd nam) ) )
     1345                                (set! buflen cnt)
     1346                                (set! bufpos 0) ) )]
     1347                         [else
     1348                          (set! buflen cnt)
     1349                          (set! bufpos 0)]) ) )  )] )
    13511350        (letrec ([this-port
    13521351                  (make-input-port
    13531352                   (lambda ()           ; read-char
    1354                      (fetch)
    13551353                     (let ([ch (peek)])
    13561354                       #; ; Allow increment since overflow is far, far away
    13571355                       (unless (eof-object? ch) (set! bufpos (fx+ bufpos 1)))
    … … EOF 
    13671365                         (posix-error #:file-error loc "cannot close" fd nam) )
    13681366                       (on-close) ) )
    13691367                   (lambda ()           ; peek-char
    1370                      (fetch)
     1368                     (when (fx>= bufpos buflen)
     1369                       (fetch))
    13711370                     (peek) )
    13721371                   (lambda (port n dest start) ; read-string!
    13731372                     (let loop ([n (or n (fx- (##sys#size dest) start))] [m 0] [start start])
    13741373                       (cond [(eq? 0 n) m]
    13751374                             [(fx< bufpos buflen)
    1376                               (let* ([rest (fx- buflen bufpos)]
    1377                                      [n2 (if (fx< n rest) n rest)])
    1378                                 (##core#inline "C_substring_copy" buf dest bufpos (fx+ bufpos n2) start)
    1379                                 (set! bufpos (fx+ bufpos n2))
    1380                                 (loop (fx- n n2) (fx+ m n2) (fx+ start n2)) ) ]
     1375                              (let* ([rest (fx- buflen bufpos)]
     1376                                     [n2 (if (fx< n rest) n rest)])
     1377                                (##core#inline "C_substring_copy" buf dest bufpos (fx+ bufpos n2) start)
     1378                                (set! bufpos (fx+ bufpos n2))
     1379                                (loop (fx- n n2) (fx+ m n2) (fx+ start n2)) ) ]
    13811380                             [else
    1382                               (fetch)
    1383                               (if (eq? 0 buflen)
    1384                                   m
    1385                                   (loop n m start) ) ] ) ) )
     1381                              (fetch)
     1382                              (if (eq? 0 buflen)
     1383                                  m
     1384                                  (loop n m start) ) ] ) ) )
    13861385                   (lambda (port limit) ; read-line
    13871386                     (when (fx>= bufpos buflen)
    13881387                       (fetch))