Scheduler friendly file-select like API. pasted by Kooda on Tue Jan 10 02:42:32 2017

(module thread-select (thread-select!)
(import scheme chicken) 
(use srfi-1 srfi-18)
 
(define (io-thread fd mode mutex)
  (make-thread (lambda () (thread-wait-for-i/o! fd mode) (mutex-unlock! mutex))))

(define (fd-ready thread fd)
  (and (eq? (thread-state thread) 'dead)
       fd))

(define (thread-select! in-fds out-fds #!optional (timeout #f))
  (let* ((done-mutex (make-mutex))
         (in-threads (map (lambda (fd) (io-thread fd #:input done-mutex)) in-fds))
         (out-threads (map (lambda (fd) (io-thread fd #:output done-mutex)) out-fds))
         (all-threads (append in-threads out-threads)))
    (mutex-lock! done-mutex)
    (for-each thread-start! all-threads)
    (print (mutex-lock! done-mutex timeout))
    (print (map thread-state all-threads))
    (let ((in-ready (filter-map fd-ready in-threads in-fds))
          (out-ready (filter-map fd-ready out-threads out-fds)))
      (for-each thread-terminate! all-threads)
      (values in-ready out-ready))))

)

Without debug and with correct timeout support. added by Kooda on Tue Jan 10 03:59:37 2017

(module thread-select (thread-select!)
(import scheme chicken) 
(use srfi-1 srfi-18)
 
(define (io-thread fd mode mutex)
  (make-thread (lambda () (thread-wait-for-i/o! fd mode) (mutex-unlock! mutex))))

(define (fd-ready thread fd)
  (and (eq? (thread-state thread) 'dead)
       fd))

(define (thread-select! in-fds out-fds #!optional (timeout #f))
  (let* ((done-mutex (make-mutex))
         (in-threads (map (lambda (fd) (io-thread fd #:input done-mutex))
                       (or in-fds '())))
         (out-threads (map (lambda (fd) (io-thread fd #:output done-mutex))
                        (or out-fds '())))
         (all-threads (append in-threads out-threads)))
    (mutex-lock! done-mutex)
    (for-each thread-start! all-threads)
    (if (mutex-lock! done-mutex timeout)
        (let ((in-ready (filter-map fd-ready in-threads in-fds))
              (out-ready (filter-map fd-ready out-threads out-fds)))
          (for-each thread-terminate! all-threads)
          (values in-ready out-ready))
        (values #f #f))))

)