basis/io/unix/multiplexers/run-loop/run-loop.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel namespaces math accessors threads alien locals
   4 destructors combinators io.unix.multiplexers
   5 io.unix.multiplexers.kqueue core-foundation
   6 core-foundation.run-loop core-foundation.file-descriptors ;
   7 IN: io.unix.multiplexers.run-loop
   8
   9 TUPLE: run-loop-mx kqueue-mx fd source ;
  10
  11 : kqueue-callback ( -- callback )
  12     "void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" }
  13     "cdecl" [
  14         3drop
  15         0 mx get kqueue-mx>> wait-for-events
  16         mx get fd>> enable-all-callbacks
  17         yield
  18     ]
  19     alien-callback ;
  20
  21 SYMBOL: kqueue-run-loop-source
  22
  23 : create-kqueue-source ( fd -- source )
  24     f swap 0 CFFileDescriptorCreateRunLoopSource ;
  25
  26 : add-kqueue-to-run-loop ( mx -- )
  27     CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopAddSource ;
  28
  29 : remove-kqueue-from-run-loop ( source -- )
  30     CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopRemoveSource ;
  31
  32 : <run-loop-mx> ( -- mx )
  33     [
  34         <kqueue-mx> |dispose
  35         dup fd>> kqueue-callback <CFFileDescriptor> |dispose
  36         dup create-kqueue-source run-loop-mx boa
  37         dup add-kqueue-to-run-loop
  38     ] with-destructors ;
  39
  40 M: run-loop-mx dispose
  41     [
  42         {
  43             [ fd>> &CFRelease drop ]
  44             [ source>> &CFRelease drop ]
  45             [ remove-kqueue-from-run-loop ]
  46             [ kqueue-mx>> &dispose drop ]
  47         } cleave
  48     ] with-destructors ;
  49
  50 M: run-loop-mx add-input-callback kqueue-mx>> add-input-callback ;
  51 M: run-loop-mx add-output-callback kqueue-mx>> add-output-callback ;
  52 M: run-loop-mx remove-input-callbacks kqueue-mx>> remove-input-callbacks ;
  53 M: run-loop-mx remove-output-callbacks kqueue-mx>> remove-output-callbacks ;
  54
  55 M:: run-loop-mx wait-for-events ( us mx -- )
  56     mx fd>> enable-all-callbacks
  57     CFRunLoopDefaultMode us [ 1000000 /f ] [ 60 ] if* t CFRunLoopRunInMode
  58     kCFRunLoopRunHandledSource = [ 0 mx wait-for-events ] when ;