;; -*- Mode: Irken -*-
;; for each EVFILT, we have separate map of ident=>continuation
(define (make-poller)
{ kqfd = (kqueue)
runnable = (queue/make)
nwait = 0 ;; how many events are waiting?
filters = (make-vector EVFILT_SYSCOUNT (tree/empty))
ievents = (make-changelist 1000)
oevents = (make-changelist 1000)
})
(define the-poller (make-poller))
(define (poller/enqueue k)
(queue/add the-poller.runnable k))
;; TODO: since this code is using getcc/putcc directly, it's possible
;; that it's not type-safe around coro switch boundaries. look into
;; this.
(define (poller/fork f)
(poller/enqueue (getcc))
(f)
(poller/dispatch))
(define (poller/yield)
(poller/enqueue (getcc))
(poller/dispatch))
(define (poller/dispatch)
(match (queue/pop the-poller.runnable) with
(maybe:yes k) -> (putcc k #u)
(maybe:no) -> (poller/wait-and-schedule)))
;; these funs know that EVFILT values are consecutive small negative ints
;; here's a question: is this an abuse of macros? Does it make the code
;; harder or easier to read? I think this is related to 'setf' in CL -
;; since the target of set! can't be a funcall.
(defmacro kfilt (kfilt f) -> the-poller.filters[(- 0 f)])
(define (poller/lookup-event ident filter)
(tree/member (kfilt filter) < ident))
(define (poller/add-event ident filter k)
(set! the-poller.nwait (+ 1 the-poller.nwait))
(tree/insert! (kfilt filter) < ident k))
(define (poller/delete-event ident filter)
(tree/delete! (kfilt filter) ident < =))
(set! the-poller.nwait (- the-poller.nwait 1))
;; put the current thread to sleep while waiting for the kevent (ident, filter).
(define (poller/wait-for ident filter)
(let ((k (getcc)))
(match (poller/lookup-event ident filter) with
(maybe:no)
-> (begin
(add-kevent the-poller.ievents ident filter EV_ADDONE)
(poller/add-event ident filter k)
(poller/dispatch)
#u
)
(maybe:yes _) -> (raise (:PollerEventAlreadyPresent))
)))
(define (poller/wait-for-read fd)
(poller/wait-for fd EVFILT_READ))
(define (poller/wait-for-write fd)
(poller/wait-for fd EVFILT_WRITE))
(define poller/enqueue-waiting-thread
(:kev ident filter)
-> (match (poller/lookup-event ident filter) with
(maybe:yes k) -> (begin
(poller/delete-event ident filter)
(poller/enqueue k))
(maybe:no) -> (raise (:PollerNoSuchEvent ident filter))))
(define (poller/wait-and-schedule)
;; all the runnable threads have done their bit, now throw it to kevent().
(if (= the-poller.nwait 0)
(print-string "no events, will wait forever!\n"))
(let ((n (syscall (kevent the-poller.kqfd the-poller.ievents the-poller.oevents))))
;;(print-string (format "poller/wait-and-schedule: got " (int n) " events\n"))
(set! the-poller.ievents.index 0)
(for-range
i n
(poller/enqueue-waiting-thread
(get-kevent the-poller.oevents i)))
(poller/dispatch)
))