kqueue work in progress

db4
Slava Pestov 2008-01-18 20:29:43 -05:00
parent 8339cb0b4a
commit 74329237e6
2 changed files with 48 additions and 24 deletions

View File

@ -1,14 +1,16 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax kernel io.nonblocking io.unix.backend USING: alien.c-types kernel io.nonblocking io.unix.backend
sequences assocs unix unix.kqueue math namespaces ; io.unix.sockets sequences assocs unix unix.kqueue math
namespaces classes combinators ;
IN: io.unix.backend.kqueue IN: io.unix.backend.kqueue
TUPLE: unix-kqueue-io ; TUPLE: unix-kqueue-io ;
! Global variables ! Global variables
SYMBOL: kqueue-fd SYMBOL: kqueue-fd
SYMBOL: kqueue-changes SYMBOL: kqueue-added
SYMBOL: kqueue-deleted
SYMBOL: kqueue-events SYMBOL: kqueue-events
: max-events ( -- n ) : max-events ( -- n )
@ -17,26 +19,43 @@ SYMBOL: kqueue-events
256 ; inline 256 ; inline
M: unix-kqueue-io init-unix-io ( -- ) M: unix-kqueue-io init-unix-io ( -- )
V{ } clone kqueue-changes set-global H{ } clone kqueue-added set-global
H{ } clone kqueue-deleted set-global
max-events "kevent" <c-array> kqueue-events set-global max-events "kevent" <c-array> kqueue-events set-global
kqueue kqueue-fd dup io-error set-global ; kqueue dup io-error kqueue-fd set-global ;
: add-change ( event -- ) kqueue-changes get-global push ; M: unix-kqueue-io register-io-task ( task -- )
dup io-task-fd kqueue-added get-global key? [ drop ] [
dup io-task-fd kqueue-deleted get-global key? [
io-task-fd kqueue-deleted get-global delete-at
] [
dup io-task-fd kqueue-added get-global set-at
] if
] if ;
M: unix-kqueue-io unregister-io-task ( task -- )
dup io-task-fd kqueue-deleted get-global key? [ drop ] [
dup io-task-fd kqueue-added get-global key? [
io-task-fd kqueue-added get-global delete-at
] [
dup io-task-fd kqueue-deleted get-global set-at
] if
] if ;
: io-task-filter ( task -- n ) : io-task-filter ( task -- n )
class { class {
{ read-task EVFILT_READ } { read-task [ EVFILT_READ ] }
{ accept-task EVFILT_READ } { accept-task [ EVFILT_READ ] }
{ receive-task EVFILT_READ } { receive-task [ EVFILT_READ ] }
{ write-task EVFILT_WRITE } { write-task [ EVFILT_WRITE ] }
{ connect-task EVFILT_WRITE } { connect-task [ EVFILT_WRITE ] }
{ send-task EVFILT_WRITE } { send-task [ EVFILT_WRITE ] }
} case ; } case ;
: make-kevent ( task -- event ) : make-kevent ( task -- event )
"kevent" <c-object> "kevent" <c-object>
over io-task-fd over set-kevent-ident over io-task-fd over set-kevent-ident
over io-task-filter over set-kevent-filter ; swap io-task-filter over set-kevent-filter ;
: make-add-kevent ( task -- event ) : make-add-kevent ( task -- event )
make-kevent make-kevent
@ -46,15 +65,19 @@ M: unix-kqueue-io init-unix-io ( -- )
make-kevent make-kevent
EV_DELETE over set-kevent-flags ; EV_DELETE over set-kevent-flags ;
M: unix-select-io register-io-task ( task -- ) : kqueue-additions ( -- kevents )
make-add-kevent add-change ; kqueue-added get-global
dup clear-assoc values
[ make-add-kevent ] map ;
M: unix-select-io unregister-io-task ( task -- ) : kqueue-deletions ( -- kevents )
make-delete-kevent add-change ; kqueue-deleted get-global
dup clear-assoc values
[ make-delete-kevent ] map ;
: kqueue-changelist ( -- byte-array n ) : kqueue-changelist ( -- byte-array n )
kqueue-changes get-global kqueue-additions kqueue-deletions append
dup concat f like over length rot delete-all ; dup concat f like swap length ;
: kqueue-eventlist ( -- byte-array n ) : kqueue-eventlist ( -- byte-array n )
kqueue-events get-global max-events ; kqueue-events get-global max-events ;
@ -67,15 +90,15 @@ M: unix-select-io unregister-io-task ( task -- )
r> kevent dup multiplexer-error ; r> kevent dup multiplexer-error ;
: kevent-task ( kevent -- task ) : kevent-task ( kevent -- task )
dup kevent-filter { dup kevent-ident swap kevent-filter {
{ [ dup EVFILT_READ = ] [ read-tasks ] } { [ dup EVFILT_READ = ] [ read-tasks ] }
{ [ dup EVFILT_WRITE = ] [ write-tasks ] } { [ dup EVFILT_WRITE = ] [ write-tasks ] }
} cond get at ; } cond nip get at ;
: handle-kevents ( n eventlist -- ) : handle-kevents ( n eventlist -- )
[ kevent-nth kevent-task handle-fd ] curry each ; [ kevent-nth kevent-task handle-fd ] curry each ;
M: unix-select-io unix-io-multiplex ( ms -- ) M: unix-kqueue-io unix-io-multiplex ( ms -- )
make-timespec make-timespec
do-kevent do-kevent
kqueue-events get-global handle-kevents ; kqueue-events get-global handle-kevents ;

View File

@ -3,8 +3,9 @@ io.unix.launcher io.unix.mmap io.backend combinators namespaces
system vocabs.loader ; system vocabs.loader ;
{ {
{ [ macosx? ] [ "io.unix.backend.kqueue" ] } ! kqueue is a work in progress
{ [ bsd? ] [ "io.unix.backend.kqueue" ] } ! { [ macosx? ] [ "io.unix.backend.kqueue" ] }
! { [ bsd? ] [ "io.unix.backend.kqueue" ] }
{ [ unix? ] [ "io.unix.backend.select" ] } { [ unix? ] [ "io.unix.backend.select" ] }
} cond require } cond require