On Mon, Jun 11, 2012 at 12:33:28PM +0200, Peter Bex wrote: > Currently a patch is being developed. In the meanwhile an effective > workaround is to limit the maximum number of open descriptors using > the Unix "ulimit -n" command.
For those feeling adventurous, please test the attached patch. We are currently debating whether it should be applied, but unsure because there could be some potential portability problems with it as well as the fact that it's a reasonably large change to a core component of Chicken which is pretty subtle. It would be especially useful if people using anything *other* than Linux or BSD could report back success or failure. Cheers, Peter -- http://sjamaan.ath.cx -- "The process of preparing programs for a digital computer is especially attractive, not only because it can be economically and scientifically rewarding, but also because it can be an aesthetic experience much like composing poetry or music." -- Donald Knuth
>From 52e581254a713daa2f19693108af35a859ec7ebd Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Fri, 8 Jun 2012 22:08:40 +0200 Subject: [PATCH] Fix scheduler so it can handle file descriptors over FD_SETSIZE (which occurs in practice on systems where ulimit -n has a higher value) --- NEWS | 1 + scheduler.scm | 98 ++++++++++++++++++++++++++++++++++---------------------- 2 files changed, 60 insertions(+), 39 deletions(-) diff --git a/NEWS b/NEWS index 7ec6431..725dddc 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,7 @@ - on 64-bit machines the "random" procedure no longer truncates result values (which caused very nonrandom results for very large values). Note that random shouldn't be used for security-critical code. + - Fixed select()-calls to accommodate more than FD_SETSIZE open files. - Build system - version information has been moved into a separate unit to make the diff --git a/scheduler.scm b/scheduler.scm index e3a96bc..c28ed16 100644 --- a/scheduler.scm +++ b/scheduler.scm @@ -31,9 +31,8 @@ (hide ready-queue-head ready-queue-tail ##sys#timeout-list ##sys#update-thread-state-buffer ##sys#restore-thread-state-buffer remove-from-ready-queue ##sys#unblock-threads-for-i/o ##sys#force-primordial - fdset-input-set fdset-output-set fdset-clear - fdset-select-timeout fdset-set fdset-test - create-fdset stderr + current-fdset-size fd-iset fd-oset fdset-extend fdset-clear make-fdset + fdset-select-timeout fdset-set fdset-test create-fdset stderr ##sys#clear-i/o-state-for-thread! ##sys#abandon-mutexes) (not inline ##sys#interrupt-hook) (unsafe) @@ -74,9 +73,16 @@ C_word C_msleep(C_word ms) { return C_SCHEME_TRUE; } #endif +/* These two should be defined by select.h, but are not standardized... */ +#ifndef howmany +#define howmany(x, y) (((x)+((y)-1))/(y)) +#endif +#ifndef NFDBITS +#define NFDBITS (sizeof (fd_mask) * 8) +#endif + static fd_set C_fdset_input, C_fdset_output; -#define C_fd_test_input(fd) C_mk_bool(FD_ISSET(C_unfix(fd), &C_fdset_input)) -#define C_fd_test_output(fd) C_mk_bool(FD_ISSET(C_unfix(fd), &C_fdset_output)) +#define C_fd_test(fd,set) C_mk_bool(FD_ISSET(C_unfix(fd), (fd_set *)C_data_pointer(set))) EOF ) ) @@ -344,46 +350,61 @@ EOF (define ##sys#fd-list '()) ; ((FD1 THREAD1 ...) ...) +(define current-fdset-size 64) +(define fd-iset (make-fdset current-fdset-size)) +(define fd-oset (make-fdset current-fdset-size)) + (define (create-fdset) - (fdset-clear) - (let loop ((lst ##sys#fd-list)) - (unless (null? lst) - (let ((fd (caar lst))) - (for-each - (lambda (t) - (let ((p (##sys#slot t 11))) - (fdset-set fd (cdr p)))) - (cdar lst)) - (loop (cdr lst)))))) + (let* ((max (foldl (lambda (max x) (fxmax max (car x))) 0 ##sys#fd-list)) + (size (let lp ((s current-fdset-size)) ; Find next power of two + (if (fx> max s) (lp (fxshl s 1)) s)))) + (when (fx> size current-fdset-size) ; Adjust set sizes if neccessary + (set! current-fdset-size size) + (set! fd-iset (make-fdset size)) + (set! fd-oset (make-fdset size))) + (fdset-clear fd-iset) + (fdset-clear fd-oset) + (let loop ((lst ##sys#fd-list)) + (unless (null? lst) + (let ((fd (caar lst))) + (for-each + (lambda (t) + (let ((p (##sys#slot t 11))) + (fdset-set fd (cdr p)))) + (cdar lst)) + (loop (cdr lst))))) + max)) (define fdset-select-timeout - (foreign-lambda* int ([bool to] [double tm]) + (foreign-lambda* int ((int maxfd) (bool to) (double tm) + (scheme-pointer iset) (scheme-pointer oset)) "struct timeval timeout;" "timeout.tv_sec = tm / 1000;" "timeout.tv_usec = fmod(tm, 1000) * 1000;" - "C_return(select(FD_SETSIZE, &C_fdset_input, &C_fdset_output, NULL, to ? &timeout : NULL));") ) + "C_return(select(maxfd+1, iset, oset, NULL, to ? &timeout : NULL));") ) -(define fdset-clear - (foreign-lambda* void () - "FD_ZERO(&C_fdset_input);" - "FD_ZERO(&C_fdset_output);")) +(define (fdset-clear set) + ((foreign-lambda* void ((scheme-pointer fdset) (int size)) + "memset(fdset, 0, size);") + set (##sys#size set))) -(define fdset-input-set - (foreign-lambda* void ([int fd]) - "FD_SET(fd, &C_fdset_input);" ) ) +(define (make-fdset maxfd) + (let ((size ((foreign-lambda* int ((int maxfd)) + "C_return(howmany(maxfd+1, NFDBITS) * sizeof(fd_mask));") maxfd))) + (make-blob size))) -(define fdset-output-set - (foreign-lambda* void ([int fd]) - "FD_SET(fd, &C_fdset_output);" ) ) +(define fdset-extend + (foreign-lambda* void ((int fd) (scheme-pointer fdset)) + "FD_SET(fd, (fd_set *)fdset);" ) ) (define (fdset-set fd i/o) (dbg "setting fdset for " fd " to " i/o) (case i/o - ((#t #:input) (fdset-input-set fd)) - ((#f #:output) (fdset-output-set fd)) + ((#t #:input) (fdset-extend fd fd-iset)) + ((#f #:output) (fdset-extend fd fd-oset)) ((#:all) - (fdset-input-set fd) - (fdset-output-set fd) ) + (fdset-extend fd fd-iset) + (fdset-extend fd fd-oset) ) (else (panic "fdset-set: invalid i/o direction")))) (define (fdset-test inf outf i/o) @@ -410,8 +431,8 @@ EOF (define (##sys#unblock-threads-for-i/o) (dbg "fd-list: " ##sys#fd-list) - (create-fdset) - (let* ((to? (pair? ##sys#timeout-list)) + (let* ((maxfd (create-fdset)) + (to? (pair? ##sys#timeout-list)) (rq? (pair? ready-queue-head)) (tmo (if (and to? (not rq?)) ; no thread was unblocked by timeout, so wait (let* ((tmo1 (caar ##sys#timeout-list)) @@ -419,12 +440,11 @@ EOF (fpmax 0.0 (fp- tmo1 now)) ) 0.0) ) ) ; otherwise immediate timeout. (dbg "waiting for I/O with timeout " tmo) - (let ((n (fdset-select-timeout ; we use FD_SETSIZE, but really should use max fd - (or rq? to?) - tmo))) + (let ((n (fdset-select-timeout maxfd (or rq? to?) tmo fd-iset fd-oset))) (dbg n " fds ready") (cond [(eq? -1 n) - (dbg "select(2) returned with result -1" ) + (dbg "select(2) returned with result -1, error was: " + (foreign-value "strerror(errno)" c-string)) (##sys#force-primordial)] [(fx> n 0) (set! ##sys#fd-list @@ -433,8 +453,8 @@ EOF lst (let* ([a (car lst)] [fd (car a)] - [inf (##core#inline "C_fd_test_input" fd)] - [outf (##core#inline "C_fd_test_output" fd)]) + [inf (##core#inline "C_fd_test" fd fd-iset)] + [outf (##core#inline "C_fd_test" fd fd-oset)]) (dbg "fd " fd " state: input=" inf ", output=" outf) (if (or inf outf) (let loop2 ((threads (cdr a)) (keep '())) -- 1.7.9.1
_______________________________________________ Chicken-users mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-users
