chicken-users
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Chicken-users] EINTR with self-pipe signal trampoline


From: Jörg F . Wittenberger
Subject: Re: [Chicken-users] EINTR with self-pipe signal trampoline
Date: 29 Sep 2011 13:11:49 +0200

On Sep 29 2011, Alan Post wrote:

Below is a test case for a problem I'm seeing in some multi-process
code I'm writing.  I'm getting the error:

 Error: (file-read) cannot read from file - Interrupted system call

There are two ways to fix that: either make the posix unit thread safe
(recall my recent message how to avoid process-wait having a bad effect).

The other one is working around the problem.  That's what I'm doing based
on some code Felix supplied ages ago.  It wraps the file descriptors
into custom ports those are properly restarted on EINTR.

However I'd be rather interested to learn what exactly the problem is
you observe.  Recently (maybe 4.7.3 or .4) I'm seeing missbehavior
from formerly well working code.  I can't say that's chickens fault
but neither I can say it's not.


Here is the code.  Please excuse that uses process-wait-for-pid
and process-test-pid to avoid blocking for the childs termination.
You might replace them with process-wait whereby process-test-pid
should never block.

(define process-io-ports
 (let ([make-input-port make-input-port]
[make-output-port make-output-port] [make-string make-string] [substring substring]
        [file-close-fd! (foreign-lambda* int ((int fd)) "return(close(fd));")]
        )
   (lambda (pid fdr fdw)
     (##sys#file-nonblocking! fdw)
     (##sys#file-nonblocking! fdr)      ; should not be required
     (let* ([buf (make-string buffer-size)]
             ;; [data (vector #f #f #f)]
             [buflen 0]
             [bufindex 0]
             [iclosed #f]
             [oclosed #f]
             [in
              (make-input-port
               (let-location
                ((again bool #f))
                (lambda ()
                  (when (fx>= bufindex buflen)
                        (let loop ()
                          (and (not iclosed)
                               (let ([n ((foreign-lambda*
                                          int
                                          ((int fd) (scheme-pointer buf) (int 
s) ((c-pointer bool) again))
"int r = read(fd, buf, s); *again=(r==-1)&&(errno == EAGAIN); return(r);")
                                         fdr buf buffer-size (location again))])
                                 (cond
                                  (again
                                   (thread-wait-for-i/o! fdr #:input)
                                   (loop))
                                  ((eq? -1 n)
                                   ;; (##sys#update-errno)
;; (##sys#signal-hook #:process-error 'process-io-read "can not read from fd" fdr strerror)
                                   (set! iclosed #t)
                                   #;(when (eq? -1 (file-close-fd! fdr))
                                   (##sys#update-errno)
                                   (##sys#signal-hook #:process-error 
'process-io-read
                                   "can not close fd input port" fdr) )
                                   (file-close-fd! fdr))
                                  (else
                                   ;; (print "[rd: " n "]")
                                   (set! buflen n)
                                   (set! bufindex 0))) ))) )
                  (if (or iclosed (fx>= bufindex buflen))
                      (end-of-file)
                      (let ([c (##core#inline "C_subchar" buf bufindex)])
                        (set! bufindex (fx+ bufindex 1))
                        c) ) ))
               (lambda ()
                (when iclosed
(##sys#signal-hook #:process-error "input port is closed" fdr))
                 #t )
               (lambda ()
                 (unless iclosed
                   (set! iclosed #t)
                   (when (eq? -1 (file-close-fd! fdr))
                     (##sys#update-errno)
                     (##sys#signal-hook #:process-error 'process-io-close
                                       "can not close fd input port" fdr) )
                  (if oclosed
                       (receive (p f s) (process-wait-for-pid pid) s)
                       (receive (p f s) (process-test-pid pid)
                          (when (eqv? p pid)
                            (set! oclosed #t)
                            (when (eq? -1 (file-close-fd! fdw))
                               (##sys#update-errno)
                               (##sys#signal-hook #:process-error 
'process-io-close
                                                  "can not close fd output 
port" fdw) ) s)))
                    ) ) ) ]
             [out
              (let-location
               ((again bool #f))
               (make-output-port
                (lambda (s)
                  (define start-time (current-milliseconds))
                  (let loop ([len (##sys#size s)]
                             [off 0])
                    (if oclosed
                        (##sys#signal-hook
                         #:process-error 'process-io-write "fd output port is 
closed" fdw)
                        (let ([n ((foreign-lambda*
                                   int
((int fd) (scheme-pointer buf) (int off) (int count) ((c-pointer bool) again)) "int r = write(fd, ((char*)buf)+off, count); *again=(r==-1)&&(errno == EAGAIN); return(r);")
                                  fdw s off len (location again))])
                          (cond [again
                                 (thread-wait-for-i/o! fdw #:output)
                                 (loop len off)]
                                [(eq? -1 n)
                                 (##sys#update-errno)
                                 (##sys#signal-hook
                                  #:process-error 'process-io-write
                                  "can not write to fd" fdw len strerror) ]
                                [(fx< n len)
                                 (loop (fx- len n) (fx+ off n)) ] )
                          (process-io-update-bandwith! (##sys#size s) 
start-time) ))))
                (lambda ()
                  (unless oclosed
                          (set! oclosed #t)
                          (when (eq? -1 (file-close-fd! fdw))
                                (##sys#update-errno)
                                (##sys#signal-hook #:process-error 
'process-io-close
                                                   "can not close fd output 
port" fdw) )
                          (if iclosed
                              (receive (p f s) (process-wait-for-pid pid) s)
                              (receive (p f s) (process-test-pid pid)
                                       (when (eqv? p pid)
                                             (set! iclosed #t)
                                             (when (eq? -1 (file-close-fd! fdr))
                                                   (##sys#update-errno)
                                                   (##sys#signal-hook 
#:process-error 'process-io-close
                                                                      "can not close 
fd input port" fdr) ) s)))) ))) ] )
        (values in out) ) ) ) )






reply via email to

[Prev in Thread] Current Thread [Next in Thread]