basis/core-foundation/run-loop/run-loop.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types alien.syntax
   4 core-foundation core-foundation.file-descriptors
   5 core-foundation.strings core-foundation.time
   6 core-foundation.timers destructors init kernel math namespaces
   7 sequences threads ;
   8 FROM: calendar.unix => system-micros ;
   9 IN: core-foundation.run-loop
  10
  11 CONSTANT: kCFRunLoopRunFinished 1
  12 CONSTANT: kCFRunLoopRunStopped 2
  13 CONSTANT: kCFRunLoopRunTimedOut 3
  14 CONSTANT: kCFRunLoopRunHandledSource 4
  15
  16 TYPEDEF: void* CFRunLoopRef
  17 TYPEDEF: void* CFRunLoopSourceRef
  18
  19 FUNCTION: CFRunLoopRef CFRunLoopGetMain ( )
  20 FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( )
  21
  22 FUNCTION: SInt32 CFRunLoopRunInMode (
  23     CFStringRef mode,
  24     CFTimeInterval seconds,
  25     Boolean returnAfterSourceHandled
  26 )
  27
  28 FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource (
  29     CFAllocatorRef allocator,
  30     CFFileDescriptorRef f,
  31     CFIndex order
  32 )
  33
  34 FUNCTION: void CFRunLoopAddSource (
  35     CFRunLoopRef rl,
  36     CFRunLoopSourceRef source,
  37     CFStringRef mode
  38 )
  39
  40 FUNCTION: void CFRunLoopRemoveSource (
  41     CFRunLoopRef rl,
  42     CFRunLoopSourceRef source,
  43     CFStringRef mode
  44 )
  45
  46 FUNCTION: void CFRunLoopAddTimer (
  47     CFRunLoopRef rl,
  48     CFRunLoopTimerRef timer,
  49     CFStringRef mode
  50 )
  51
  52 FUNCTION: void CFRunLoopRemoveTimer (
  53     CFRunLoopRef rl,
  54     CFRunLoopTimerRef timer,
  55     CFStringRef mode
  56 )
  57
  58 CFSTRING: CFRunLoopDefaultMode "kCFRunLoopDefaultMode"
  59
  60 TUPLE: run-loop-state fds sources timers ;
  61
  62 SYMBOL: run-loop
  63
  64 : <run-loop> ( -- run-loop )
  65     V{ } clone V{ } clone V{ } clone \ run-loop-state boa ;
  66
  67 : get-run-loop ( -- run-loop )
  68     \ run-loop [ <run-loop> ] initialize-alien ;
  69
  70 : add-source-to-run-loop ( source -- )
  71     [ get-run-loop sources>> push ]
  72     [
  73         CFRunLoopGetMain
  74         swap CFRunLoopDefaultMode
  75         CFRunLoopAddSource
  76     ] bi ;
  77
  78 : create-fd-source ( CFFileDescriptor -- source )
  79     f swap 0 CFFileDescriptorCreateRunLoopSource ;
  80
  81 : add-fd-to-run-loop ( fd callback -- )
  82     [
  83         <CFFileDescriptor> |CFRelease
  84         [ enable-all-callbacks ]
  85         [ get-run-loop fds>> push ]
  86         [ create-fd-source |CFRelease add-source-to-run-loop ]
  87         tri
  88     ] with-destructors ;
  89
  90 : add-timer-to-run-loop ( timer -- )
  91     [ get-run-loop timers>> push ]
  92     [
  93         CFRunLoopGetMain
  94         swap CFRunLoopDefaultMode
  95         CFRunLoopAddTimer
  96     ] bi ;
  97
  98 : invalidate-run-loop-timers ( -- )
  99     get-run-loop [
 100         [ [ CFRunLoopTimerInvalidate ] [ CFRelease ] bi ] each
 101         V{ } clone
 102     ] change-timers drop ;
 103
 104 SYMBOL: thread-timer
 105
 106 STARTUP-HOOK: [ f thread-timer set-global ]
 107
 108 : (reset-thread-timer) ( timer -- )
 109     sleep-time
 110     [ 1000 /f ] [ 1,000,000 ] if* system-micros +
 111     >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
 112
 113 : reset-thread-timer ( -- )
 114     thread-timer get-global [ (reset-thread-timer) ] when* ;
 115
 116 : thread-timer-callback ( -- callback )
 117     [ drop (reset-thread-timer) yield ] CFRunLoopTimerCallBack ;
 118
 119 : init-thread-timer ( -- )
 120     60 thread-timer-callback <CFTimer>
 121     [ add-timer-to-run-loop ]
 122     [ thread-timer set-global ] bi ;
 123
 124 : run-one-iteration ( nanos -- handled? )
 125     CFRunLoopDefaultMode
 126     swap [ 1,000,000,000 /f ] [ 300 ] if*
 127     t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;