From d62e867db3c620cbd90991d40fc2d910fca15a1d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 6 Dec 2008 17:35:15 -0600 Subject: [PATCH] Dusting off old kqueue code --- basis/io/unix/kqueue/kqueue.factor | 166 +++++++++-------------------- 1 file changed, 49 insertions(+), 117 deletions(-) diff --git a/basis/io/unix/kqueue/kqueue.factor b/basis/io/unix/kqueue/kqueue.factor index ba4240de7f..6b687a8afb 100644 --- a/basis/io/unix/kqueue/kqueue.factor +++ b/basis/io/unix/kqueue/kqueue.factor @@ -1,11 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel math math.bitwise namespaces -locals accessors combinators threads vectors hashtables -sequences assocs continuations sets -unix unix.time unix.kqueue unix.process -io.ports io.unix.backend io.launcher io.unix.launcher -io.monitors ; +USING: accessors alien.c-types combinators io.unix.backend +kernel math.bitwise sequences struct-arrays unix unix.kqueue +unix.time ; IN: io.unix.kqueue TUPLE: kqueue-mx < mx events monitors ; @@ -19,131 +16,66 @@ TUPLE: kqueue-mx < mx events monitors ; kqueue-mx new-mx H{ } clone >>monitors kqueue dup io-error >>fd - max-events "kevent" >>events ; + max-events "kevent" >>events ; -GENERIC: io-task-filter ( task -- n ) - -M: input-task io-task-filter drop EVFILT_READ ; - -M: output-task io-task-filter drop EVFILT_WRITE ; - -GENERIC: io-task-fflags ( task -- n ) - -M: io-task io-task-fflags drop 0 ; - -: make-kevent ( task flags -- event ) +: make-kevent ( fd filter flags -- event ) "kevent" - tuck set-kevent-flags - over io-task-fd over set-kevent-ident - over io-task-fflags over set-kevent-fflags - swap io-task-filter over set-kevent-filter ; + [ set-kevent-flags ] keep + [ set-kevent-filter ] keep + [ set-kevent-ident ] keep ; : register-kevent ( kevent mx -- ) - fd>> swap 1 f 0 f kevent - 0 < [ err_no ESRCH = [ (io-error) ] unless ] when ; + fd>> swap 1 f 0 f kevent io-error ; -M: kqueue-mx register-io-task ( task mx -- ) - [ >r EV_ADD make-kevent r> register-kevent ] - [ call-next-method ] - 2bi ; +M: kqueue-mx add-input-callback ( thread fd mx -- ) + [ call-next-method ] [ + [ EVFILT_READ { EV_ADD EV_ONESHOT } flags make-kevent ] dip + register-kevent + ] 2bi ; -M: kqueue-mx unregister-io-task ( task mx -- ) - [ call-next-method ] - [ >r EV_DELETE make-kevent r> register-kevent ] - 2bi ; +M: kqueue-mx add-output-callback ( thread fd mx -- ) + [ call-next-method ] [ + [ EVFILT_WRITE EV_DELETE make-kevent ] dip + register-kevent + ] 2bi ; + +: cancel-input-callbacks ( fd mx -- seq ) + [ + [ EVFILT_READ EV_DELETE make-kevent ] dip + register-kevent + ] [ remove-input-callbacks ] 2bi ; + +: cancel-output-callbacks ( fd mx -- seq ) + [ + [ EVFILT_WRITE EV_DELETE make-kevent ] dip + register-kevent + ] [ remove-output-callbacks ] 2bi ; + +M: fd cancel-operation ( fd -- ) + dup disposed>> [ drop ] [ + fd>> + mx get-global + [ cancel-input-callbacks [ t swap resume-with ] each ] + [ cancel-output-callbacks [ t swap resume-with ] each ] + 2bi + ] if ; : wait-kevent ( mx timespec -- n ) - >r [ fd>> f 0 ] keep events>> max-events r> kevent + [ + [ fd>> f 0 ] + [ events>> [ underlying>> ] [ length ] bi ] bi + ] dip kevent dup multiplexer-error ; -:: kevent-read-task ( mx fd kevent -- ) - mx fd mx reads>> at perform-io-task ; - -:: kevent-write-task ( mx fd kevent -- ) - mx fd mx writes>> at perform-io-task ; - -:: kevent-proc-task ( mx pid kevent -- ) - pid wait-for-pid - pid find-process - dup [ swap notify-exit ] [ 2drop ] if ; - -: parse-action ( mask -- changed ) - [ - NOTE_DELETE +remove-file+ ?flag - NOTE_WRITE +modify-file+ ?flag - NOTE_EXTEND +modify-file+ ?flag - NOTE_ATTRIB +modify-file+ ?flag - NOTE_RENAME +rename-file+ ?flag - NOTE_REVOKE +remove-file+ ?flag - drop - ] { } make prune ; - -:: kevent-vnode-task ( mx kevent fd -- ) - "" - kevent kevent-fflags parse-action - fd mx monitors>> at queue-change ; - : handle-kevent ( mx kevent -- ) - [ ] [ kevent-ident ] [ kevent-filter ] tri { - { [ dup EVFILT_READ = ] [ drop kevent-read-task ] } - { [ dup EVFILT_WRITE = ] [ drop kevent-write-task ] } - { [ dup EVFILT_PROC = ] [ drop kevent-proc-task ] } - { [ dup EVFILT_VNODE = ] [ drop kevent-vnode-task ] } - } cond ; + [ kevent-ident swap ] [ kevent-filter ] bi { + { EVFILT_READ [ input-available ] } + { EVFILT_WRITE [ output-available ] } + } case ; : handle-kevents ( mx n -- ) - [ over events>> kevent-nth handle-kevent ] with each ; + [ dup events>> ] dip head-slice [ handle-kevent ] with each ; M: kqueue-mx wait-for-events ( us mx -- ) swap dup [ make-timespec ] when dupd wait-kevent handle-kevents ; - -! Procs -: make-proc-kevent ( pid -- kevent ) - "kevent" - tuck set-kevent-ident - EV_ADD over set-kevent-flags - EVFILT_PROC over set-kevent-filter - NOTE_EXIT over set-kevent-fflags ; - -: register-pid-task ( pid mx -- ) - swap make-proc-kevent swap register-kevent ; - -! VNodes -TUPLE: vnode-monitor < monitor fd ; - -: vnode-fflags ( -- n ) - { - NOTE_DELETE - NOTE_WRITE - NOTE_EXTEND - NOTE_ATTRIB - NOTE_LINK - NOTE_RENAME - NOTE_REVOKE - } flags ; - -: make-vnode-kevent ( fd flags -- kevent ) - "kevent" - tuck set-kevent-flags - tuck set-kevent-ident - EVFILT_VNODE over set-kevent-filter - vnode-fflags over set-kevent-fflags ; - -: register-monitor ( monitor mx -- ) - >r dup fd>> r> - [ >r EV_ADD EV_CLEAR bitor make-vnode-kevent r> register-kevent drop ] - [ monitors>> set-at ] 3bi ; - -: unregister-monitor ( monitor mx -- ) - >r fd>> r> - [ monitors>> delete-at ] - [ >r EV_DELETE make-vnode-kevent r> register-kevent ] 2bi ; - -: ( path mailbox -- monitor ) - >r [ O_RDONLY 0 open dup io-error ] keep r> - vnode-monitor new-monitor swap >>fd - [ dup kqueue-mx get register-monitor ] [ ] [ fd>> close ] cleanup ; - -M: vnode-monitor dispose - [ kqueue-mx get unregister-monitor ] [ fd>> close ] bi ;