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 [
60 "kCFRunLoopDefaultMode" <CFString>
63 TUPLE: run-loop fds sources timers ;
65 : <run-loop> ( -- run-loop )
66 V{ } clone V{ } clone V{ } clone \ run-loop boa ;
68 : run-loop ( -- run-loop )
69 \ run-loop [ <run-loop> ] initialize-alien ;
71 : add-source-to-run-loop ( source -- )
72 [ run-loop sources>> push ]
75 swap CFRunLoopDefaultMode
79 : create-fd-source ( CFFileDescriptor -- source )
80 f swap 0 CFFileDescriptorCreateRunLoopSource ;
82 : add-fd-to-run-loop ( fd callback -- )
84 <CFFileDescriptor> |CFRelease
85 [ run-loop fds>> push ]
86 [ create-fd-source |CFRelease add-source-to-run-loop ]
90 : add-timer-to-run-loop ( timer -- )
91 [ run-loop timers>> push ]
94 swap CFRunLoopDefaultMode
100 : ((reset-timer)) ( timer counter timestamp -- )
101 nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
103 : (reset-timer) ( timer counter -- )
105 { [ dup 0 = ] [ now ((reset-timer)) ] }
106 { [ run-queue deque-empty? not ] [ 1- (reset-timer) ] }
107 { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
108 [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
111 : reset-timer ( timer -- )
116 : reset-run-loop ( -- )
118 [ timers>> [ reset-timer ] each ]
119 [ fds>> [ enable-all-callbacks ] each ] bi ;
121 : timer-callback ( -- callback )
122 "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
123 [ 2drop reset-run-loop yield ] alien-callback ;
125 : init-thread-timer ( -- )
126 timer-callback <CFTimer> add-timer-to-run-loop ;
128 : run-one-iteration ( us -- handled? )
131 swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
132 t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;