1 ! Copyright (C) 2008 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.syntax kernel math
4 namespaces sequences destructors combinators threads heaps
5 deques calendar 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 CFSTRING: CFRunLoopDefaultMode "kCFRunLoopDefaultMode"
59 TUPLE: run-loop fds sources timers ;
61 : <run-loop> ( -- run-loop )
62 V{ } clone V{ } clone V{ } clone \ run-loop boa ;
64 : run-loop ( -- run-loop )
65 \ run-loop [ <run-loop> ] initialize-alien ;
67 : add-source-to-run-loop ( source -- )
68 [ run-loop sources>> push ]
71 swap CFRunLoopDefaultMode
75 : create-fd-source ( CFFileDescriptor -- source )
76 f swap 0 CFFileDescriptorCreateRunLoopSource ;
78 : add-fd-to-run-loop ( fd callback -- )
80 <CFFileDescriptor> |CFRelease
81 [ run-loop fds>> push ]
82 [ create-fd-source |CFRelease add-source-to-run-loop ]
86 : add-timer-to-run-loop ( timer -- )
87 [ run-loop timers>> push ]
90 swap CFRunLoopDefaultMode
96 : ((reset-timer)) ( timer counter timestamp -- )
97 nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
99 : (reset-timer) ( timer counter -- )
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)) ]
107 : reset-timer ( timer -- )
112 : reset-run-loop ( -- )
114 [ timers>> [ reset-timer ] each ]
115 [ fds>> [ enable-all-callbacks ] each ] bi ;
117 : timer-callback ( -- callback )
118 "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
119 [ 2drop reset-run-loop yield ] alien-callback ;
121 : init-thread-timer ( -- )
122 timer-callback <CFTimer> add-timer-to-run-loop ;
124 : run-one-iteration ( us -- handled? )
127 swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
128 t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;