Welcome to the CHICKEN Scheme pasting service
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))))
)