basis/io/unix/epoll/epoll.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types kernel io.ports io.unix.backend
   4 bit-arrays sequences assocs struct-arrays math namespaces locals
   5 fry unix unix.linux.epoll unix.time ;
   6 IN: io.unix.epoll
   7
   8 TUPLE: epoll-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 : <epoll-mx> ( -- mx )
  16     epoll-mx new-mx
  17         max-events epoll_create dup io-error >>fd
  18         max-events "epoll-event" <struct-array> >>events ;
  19
  20 : make-event ( fd events -- event )
  21     "epoll-event" <c-object>
  22     [ set-epoll-event-events ] keep
  23     [ set-epoll-event-fd ] keep ;
  24
  25 :: do-epoll-ctl ( fd mx what events -- )
  26     mx fd>> what fd fd events make-event epoll_ctl io-error ;
  27
  28 : do-epoll-add ( fd mx events -- )
  29     EPOLL_CTL_ADD swap EPOLLONESHOT bitor do-epoll-ctl ;
  30
  31 : do-epoll-del ( fd mx events -- )
  32     EPOLL_CTL_DEL swap do-epoll-ctl ;
  33
  34 M: epoll-mx add-input-callback ( thread fd mx -- )
  35     [ EPOLLIN do-epoll-add ] [ call-next-method ] 2bi ;
  36
  37 M: epoll-mx add-output-callback ( thread fd mx -- )
  38     [ EPOLLOUT do-epoll-add ] [ call-next-method ] 2bi ;
  39
  40 M: epoll-mx remove-input-callbacks ( fd mx -- seq )
  41     2dup reads>> key? [
  42         [ call-next-method ] [ EPOLLIN do-epoll-del ] 2bi
  43     ] [ 2drop f ] if ;
  44
  45 M: epoll-mx remove-output-callbacks ( fd mx -- seq )
  46     2dup writes>> key? [
  47         [ EPOLLOUT do-epoll-del ] [ call-next-method ] 2bi
  48     ] [ 2drop f ] if ;
  49
  50 : wait-event ( mx us -- n )
  51     [ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi*
  52     epoll_wait multiplexer-error ;
  53
  54 : handle-event ( event mx -- )
  55     [ epoll-event-fd ] dip
  56     [ EPOLLIN EPOLLOUT bitor do-epoll-del ]
  57     [ input-available ] [ output-available ] 2tri ;
  58
  59 : handle-events ( mx n -- )
  60     [ dup events>> ] dip head-slice swap '[ _ handle-event ] each ;
  61
  62 M: epoll-mx wait-for-events ( us mx -- )
  63     swap 60000000 or dupd wait-event handle-events ;