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

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