basis/io/unix/kqueue/kqueue.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types combinators io.unix.backend
   4 kernel math.bitwise sequences struct-arrays unix unix.kqueue
   5 unix.time assocs ;
   6 IN: io.unix.kqueue
   7
   8 TUPLE: kqueue-mx < mx events ;
   9
  10 : max-events ( -- n )
  11     #! We read up to 256 events at a time. This is an arbitrary
  12     #! constant...
  13     256 ; inline
  14
  15 : <kqueue-mx> ( -- mx )
  16     kqueue-mx new-mx
  17         kqueue dup io-error >>fd
  18         max-events "kevent" <struct-array> >>events ;
  19
  20 : make-kevent ( fd filter flags -- event )
  21     "kevent" <c-object>
  22     [ set-kevent-flags ] keep
  23     [ set-kevent-filter ] keep
  24     [ set-kevent-ident ] keep ;
  25
  26 : register-kevent ( kevent mx -- )
  27     fd>> swap 1 f 0 f kevent io-error ;
  28
  29 M: kqueue-mx add-input-callback ( thread fd mx -- )
  30     [ call-next-method ] [
  31         [ EVFILT_READ { EV_ADD EV_ONESHOT } flags make-kevent ] dip
  32         register-kevent
  33     ] 2bi ;
  34
  35 M: kqueue-mx add-output-callback ( thread fd mx -- )
  36     [ call-next-method ] [
  37         [ EVFILT_WRITE { EV_ADD EV_ONESHOT } flags make-kevent ] dip
  38         register-kevent
  39     ] 2bi ;
  40
  41 M: kqueue-mx remove-input-callbacks ( fd mx -- seq )
  42     2dup reads>> key? [
  43         [ call-next-method ] [
  44             [ EVFILT_READ EV_DELETE make-kevent ] dip
  45             register-kevent
  46         ] 2bi
  47     ] [ 2drop f ] if ;
  48
  49 M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
  50     2dup writes>> key? [
  51         [
  52             [ EVFILT_WRITE EV_DELETE make-kevent ] dip
  53             register-kevent
  54         ] [ call-next-method ] 2bi
  55     ] [ 2drop f ] if ;
  56
  57 : wait-kevent ( mx timespec -- n )
  58     [
  59         [ fd>> f 0 ]
  60         [ events>> [ underlying>> ] [ length ] bi ] bi
  61     ] dip kevent multiplexer-error ;
  62
  63 : handle-kevent ( mx kevent -- )
  64     [ kevent-ident swap ] [ kevent-filter ] bi {
  65         { EVFILT_READ [ input-available ] }
  66         { EVFILT_WRITE [ output-available ] }
  67     } case ;
  68
  69 : handle-kevents ( mx n -- )
  70     [ dup events>> ] dip head-slice [ handle-kevent ] with each ;
  71
  72 M: kqueue-mx wait-for-events ( us mx -- )
  73     swap dup [ make-timespec ] when
  74     dupd wait-kevent handle-kevents ;