basis/io/unix/kqueue/kqueue.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types kernel math math.bitwise namespaces
   4 locals accessors combinators threads vectors hashtables
   5 sequences assocs continuations sets
   6 unix unix.time unix.kqueue unix.process
   7 io.ports io.unix.backend io.launcher io.unix.launcher
   8 io.monitors ;
   9 IN: io.unix.kqueue
  10
  11 TUPLE: kqueue-mx < mx events monitors ;
  12
  13 : max-events ( -- n )
  14     #! We read up to 256 events at a time. This is an arbitrary
  15     #! constant...
  16     256 ; inline
  17
  18 : <kqueue-mx> ( -- mx )
  19     kqueue-mx new-mx
  20         H{ } clone >>monitors
  21         kqueue dup io-error >>fd
  22         max-events "kevent" <c-array> >>events ;
  23
  24 GENERIC: io-task-filter ( task -- n )
  25
  26 M: input-task io-task-filter drop EVFILT_READ ;
  27
  28 M: output-task io-task-filter drop EVFILT_WRITE ;
  29
  30 GENERIC: io-task-fflags ( task -- n )
  31
  32 M: io-task io-task-fflags drop 0 ;
  33
  34 : make-kevent ( task flags -- event )
  35     "kevent" <c-object>
  36     tuck set-kevent-flags
  37     over io-task-fd over set-kevent-ident
  38     over io-task-fflags over set-kevent-fflags
  39     swap io-task-filter over set-kevent-filter ;
  40
  41 : register-kevent ( kevent mx -- )
  42     fd>> swap 1 f 0 f kevent
  43     0 < [ err_no ESRCH = [ (io-error) ] unless ] when ;
  44
  45 M: kqueue-mx register-io-task ( task mx -- )
  46     [ >r EV_ADD make-kevent r> register-kevent ]
  47     [ call-next-method ]
  48     2bi ;
  49
  50 M: kqueue-mx unregister-io-task ( task mx -- )
  51     [ call-next-method ]
  52     [ >r EV_DELETE make-kevent r> register-kevent ]
  53     2bi ;
  54
  55 : wait-kevent ( mx timespec -- n )
  56     >r [ fd>> f 0 ] keep events>> max-events r> kevent
  57     dup multiplexer-error ;
  58
  59 :: kevent-read-task ( mx fd kevent -- )
  60     mx fd mx reads>> at perform-io-task ;
  61
  62 :: kevent-write-task ( mx fd kevent -- )
  63     mx fd mx writes>> at perform-io-task ;
  64
  65 :: kevent-proc-task ( mx pid kevent -- )
  66     pid wait-for-pid
  67     pid find-process
  68     dup [ swap notify-exit ] [ 2drop ] if ;
  69
  70 : parse-action ( mask -- changed )
  71     [
  72         NOTE_DELETE +remove-file+ ?flag
  73         NOTE_WRITE +modify-file+ ?flag
  74         NOTE_EXTEND +modify-file+ ?flag
  75         NOTE_ATTRIB +modify-file+ ?flag
  76         NOTE_RENAME +rename-file+ ?flag
  77         NOTE_REVOKE +remove-file+ ?flag
  78         drop
  79     ] { } make prune ;
  80
  81 :: kevent-vnode-task ( mx kevent fd -- )
  82     ""
  83     kevent kevent-fflags parse-action
  84     fd mx monitors>> at queue-change ;
  85
  86 : handle-kevent ( mx kevent -- )
  87     [ ] [ kevent-ident ] [ kevent-filter ] tri {
  88         { [ dup EVFILT_READ = ] [ drop kevent-read-task ] }
  89         { [ dup EVFILT_WRITE = ] [ drop kevent-write-task ] }
  90         { [ dup EVFILT_PROC = ] [ drop kevent-proc-task ] }
  91         { [ dup EVFILT_VNODE = ] [ drop kevent-vnode-task ] }
  92     } cond ;
  93
  94 : handle-kevents ( mx n -- )
  95     [ over events>> kevent-nth handle-kevent ] with each ;
  96
  97 M: kqueue-mx wait-for-events ( ms mx -- )
  98     swap dup [ make-timespec ] when
  99     dupd wait-kevent handle-kevents ;
 100
 101 ! Procs
 102 : make-proc-kevent ( pid -- kevent )
 103     "kevent" <c-object>
 104     tuck set-kevent-ident
 105     EV_ADD over set-kevent-flags
 106     EVFILT_PROC over set-kevent-filter
 107     NOTE_EXIT over set-kevent-fflags ;
 108
 109 : register-pid-task ( pid mx -- )
 110     swap make-proc-kevent swap register-kevent ;
 111
 112 ! VNodes
 113 TUPLE: vnode-monitor < monitor fd ;
 114
 115 : vnode-fflags ( -- n )
 116     {
 117         NOTE_DELETE
 118         NOTE_WRITE
 119         NOTE_EXTEND
 120         NOTE_ATTRIB
 121         NOTE_LINK
 122         NOTE_RENAME
 123         NOTE_REVOKE
 124     } flags ;
 125
 126 : make-vnode-kevent ( fd flags -- kevent )
 127     "kevent" <c-object>
 128     tuck set-kevent-flags
 129     tuck set-kevent-ident
 130     EVFILT_VNODE over set-kevent-filter
 131     vnode-fflags over set-kevent-fflags ;
 132
 133 : register-monitor ( monitor mx -- )
 134     >r dup fd>> r>
 135     [ >r EV_ADD EV_CLEAR bitor make-vnode-kevent r> register-kevent drop ]
 136     [ monitors>> set-at ] 3bi ;
 137
 138 : unregister-monitor ( monitor mx -- )
 139     >r fd>> r>
 140     [ monitors>> delete-at ]
 141     [ >r EV_DELETE make-vnode-kevent r> register-kevent ] 2bi ;
 142
 143 : <vnode-monitor> ( path mailbox -- monitor )
 144     >r [ O_RDONLY 0 open dup io-error ] keep r>
 145     vnode-monitor new-monitor swap >>fd
 146     [ dup kqueue-mx get register-monitor ] [ ] [ fd>> close ] cleanup ;
 147
 148 M: vnode-monitor dispose
 149     [ kqueue-mx get unregister-monitor ] [ fd>> close ] bi ;