simple poll for input added by dzoe on Tue Jan 23 14:17:50 2024

 ;; 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))))))))))