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 IN: core-foundation.run-loop
9 : kCFRunLoopRunFinished 1 ; inline
10 : kCFRunLoopRunStopped 2 ; inline
11 : kCFRunLoopRunTimedOut 3 ; inline
12 : kCFRunLoopRunHandledSource 4 ; inline
14 TYPEDEF: void* CFRunLoopRef
15 TYPEDEF: void* CFRunLoopSourceRef
17 FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;
18 FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( ) ;
20 FUNCTION: SInt32 CFRunLoopRunInMode (
22 CFTimeInterval seconds,
23 Boolean returnAfterSourceHandled
26 FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource (
27 CFAllocatorRef allocator,
28 CFFileDescriptorRef f,
32 FUNCTION: void CFRunLoopAddSource (
34 CFRunLoopSourceRef source,
38 FUNCTION: void CFRunLoopRemoveSource (
40 CFRunLoopSourceRef source,
44 FUNCTION: void CFRunLoopAddTimer (
46 CFRunLoopTimerRef timer,
50 FUNCTION: void CFRunLoopRemoveTimer (
52 CFRunLoopTimerRef timer,
56 : CFRunLoopDefaultMode ( -- alien )
57 #! Ugly, but we don't have static NSStrings
58 \ CFRunLoopDefaultMode get-global dup expired? [
60 "kCFRunLoopDefaultMode" <CFString>
61 dup \ CFRunLoopDefaultMode set-global
64 TUPLE: run-loop fds sources timers ;
66 : <run-loop> ( -- run-loop )
67 V{ } clone V{ } clone V{ } clone \ run-loop boa ;
71 : run-loop ( -- run-loop )
72 \ run-loop get-global not expiry-check get expired? or
74 31337 <alien> expiry-check set-global
75 <run-loop> dup \ run-loop set-global
76 ] [ \ run-loop get-global ] if ;
78 : add-source-to-run-loop ( source -- )
79 [ run-loop sources>> push ]
82 swap CFRunLoopDefaultMode
86 : create-fd-source ( CFFileDescriptor -- source )
87 f swap 0 CFFileDescriptorCreateRunLoopSource ;
89 : add-fd-to-run-loop ( fd callback -- )
91 <CFFileDescriptor> |CFRelease
92 [ run-loop fds>> push ]
93 [ create-fd-source |CFRelease add-source-to-run-loop ]
97 : add-timer-to-run-loop ( timer -- )
98 [ run-loop timers>> push ]
101 swap CFRunLoopDefaultMode
107 : ((reset-timer)) ( timer counter timestamp -- )
108 nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
110 : (reset-timer) ( timer counter -- )
112 { [ dup 0 = ] [ now ((reset-timer)) ] }
113 { [ run-queue deque-empty? not ] [ 1- (reset-timer) ] }
114 { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
115 [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
118 : reset-timer ( timer -- )
123 : reset-run-loop ( -- )
125 [ timers>> [ reset-timer ] each ]
126 [ fds>> [ enable-all-callbacks ] each ] bi ;
128 : timer-callback ( -- callback )
129 "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
130 [ 2drop reset-run-loop yield ] alien-callback ;
132 : init-thread-timer ( -- )
133 timer-callback <CFTimer> add-timer-to-run-loop ;
135 : run-one-iteration ( us -- handled? )
138 swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
139 t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;