;; Returns list of fds from the `fds` list that are ready for ;; reading. (define (poll-input-fds timeout-ms . fds) (let* ((nfds (length fds)) (fds-blob (make-blob (fx* nfds (foreign-value "sizeof(struct pollfd)" int)))) (timeout-arg (if timeout-ms timeout-ms -1))) ;; Fill-in the array of structs (do ((i 0 (fx+ i 1)) (fds fds (cdr fds))) ((null? fds)) ((foreign-lambda* void ((int i) (int fd) (scheme-pointer p)) "struct pollfd *fds = p;" "fds[i].fd = fd; fds[i].events = POLLIN;") i (car fds) fds-blob)) ;; Call native poll (let ((n ((foreign-lambda int "poll" scheme-pointer int int) fds-blob nfds timeout-arg))) (cond ((fx< n 0) (error "poll-input-fds: poll failed")) ((fx= n 0) '()) (else (let loop ((i 0) (res '()) (fds fds)) (cond ((null? fds) (reverse res)) (((foreign-lambda* bool ((int i) (scheme-pointer p)) "struct pollfd *fds = p;" "C_return(fds[i].revents & (POLLIN));") i fds-blob) (loop (fx+ i 1) (cons (car fds) res) (cdr fds))) (else (loop (fx+ i 1) res (cdr fds))))))))))