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
8 IN: core-foundation.run-loop
10 CONSTANT: kCFRunLoopRunFinished 1
11 CONSTANT: kCFRunLoopRunStopped 2
12 CONSTANT: kCFRunLoopRunTimedOut 3
13 CONSTANT: kCFRunLoopRunHandledSource 4
15 TYPEDEF: void* CFRunLoopRef
16 TYPEDEF: void* CFRunLoopSourceRef
18 FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;
19 FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( ) ;
21 FUNCTION: SInt32 CFRunLoopRunInMode (
23 CFTimeInterval seconds,
24 Boolean returnAfterSourceHandled
27 FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource (
28 CFAllocatorRef allocator,
29 CFFileDescriptorRef f,
33 FUNCTION: void CFRunLoopAddSource (
35 CFRunLoopSourceRef source,
39 FUNCTION: void CFRunLoopRemoveSource (
41 CFRunLoopSourceRef source,
45 FUNCTION: void CFRunLoopAddTimer (
47 CFRunLoopTimerRef timer,
51 FUNCTION: void CFRunLoopRemoveTimer (
53 CFRunLoopTimerRef timer,
57 : CFRunLoopDefaultMode ( -- alien )
58 #! Ugly, but we don't have static NSStrings
59 \ CFRunLoopDefaultMode get-global dup expired? [
61 "kCFRunLoopDefaultMode" <CFString>
62 dup \ CFRunLoopDefaultMode set-global
65 TUPLE: run-loop fds sources timers ;
67 : <run-loop> ( -- run-loop )
68 V{ } clone V{ } clone V{ } clone \ run-loop boa ;
72 : run-loop ( -- run-loop )
73 \ run-loop get-global not expiry-check get expired? or
75 31337 <alien> expiry-check set-global
76 <run-loop> dup \ run-loop set-global
77 ] [ \ run-loop get-global ] if ;
79 : add-source-to-run-loop ( source -- )
80 [ run-loop sources>> push ]
83 swap CFRunLoopDefaultMode
87 : create-fd-source ( CFFileDescriptor -- source )
88 f swap 0 CFFileDescriptorCreateRunLoopSource ;
90 : add-fd-to-run-loop ( fd callback -- )
92 <CFFileDescriptor> |CFRelease
93 [ run-loop fds>> push ]
94 [ create-fd-source |CFRelease add-source-to-run-loop ]
98 : add-timer-to-run-loop ( timer -- )
99 [ run-loop timers>> push ]
102 swap CFRunLoopDefaultMode
108 : ((reset-timer)) ( timer counter timestamp -- )
109 nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
111 : (reset-timer) ( timer counter -- )
113 { [ dup 0 = ] [ now ((reset-timer)) ] }
114 { [ run-queue deque-empty? not ] [ 1- (reset-timer) ] }
115 { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
116 [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
119 : reset-timer ( timer -- )
124 : reset-run-loop ( -- )
126 [ timers>> [ reset-timer ] each ]
127 [ fds>> [ enable-all-callbacks ] each ] bi ;
129 : timer-callback ( -- callback )
130 "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
131 [ 2drop reset-run-loop yield ] alien-callback ;
133 : init-thread-timer ( -- )
134 timer-callback <CFTimer> add-timer-to-run-loop ;
136 : run-one-iteration ( us -- handled? )
139 swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
140 t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;