! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel namespaces core-foundation
-core-foundation.strings core-foundation.file-descriptors
-core-foundation.timers ;
+USING: accessors alien alien.syntax kernel math namespaces
+sequences destructors combinators threads heaps deques calendar
+core-foundation core-foundation.strings
+core-foundation.file-descriptors core-foundation.timers
+core-foundation.time ;
IN: core-foundation.run-loop
-: kCFRunLoopRunFinished 1 ; inline
-: kCFRunLoopRunStopped 2 ; inline
-: kCFRunLoopRunTimedOut 3 ; inline
-: kCFRunLoopRunHandledSource 4 ; inline
+CONSTANT: kCFRunLoopRunFinished 1
+CONSTANT: kCFRunLoopRunStopped 2
+CONSTANT: kCFRunLoopRunTimedOut 3
+CONSTANT: kCFRunLoopRunHandledSource 4
TYPEDEF: void* CFRunLoopRef
TYPEDEF: void* CFRunLoopSourceRef
FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( ) ;
FUNCTION: SInt32 CFRunLoopRunInMode (
- CFStringRef mode,
- CFTimeInterval seconds,
- Boolean returnAfterSourceHandled
+ CFStringRef mode,
+ CFTimeInterval seconds,
+ Boolean returnAfterSourceHandled
) ;
FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource (
) ;
FUNCTION: void CFRunLoopAddSource (
- CFRunLoopRef rl,
- CFRunLoopSourceRef source,
- CFStringRef mode
+ CFRunLoopRef rl,
+ CFRunLoopSourceRef source,
+ CFStringRef mode
) ;
FUNCTION: void CFRunLoopRemoveSource (
- CFRunLoopRef rl,
- CFRunLoopSourceRef source,
- CFStringRef mode
+ CFRunLoopRef rl,
+ CFRunLoopSourceRef source,
+ CFStringRef mode
) ;
FUNCTION: void CFRunLoopAddTimer (
- CFRunLoopRef rl,
- CFRunLoopTimerRef timer,
- CFStringRef mode
+ CFRunLoopRef rl,
+ CFRunLoopTimerRef timer,
+ CFStringRef mode
) ;
FUNCTION: void CFRunLoopRemoveTimer (
- CFRunLoopRef rl,
- CFRunLoopTimerRef timer,
- CFStringRef mode
+ CFRunLoopRef rl,
+ CFRunLoopTimerRef timer,
+ CFStringRef mode
) ;
: CFRunLoopDefaultMode ( -- alien )
#! Ugly, but we don't have static NSStrings
- \ CFRunLoopDefaultMode get-global dup expired? [
- drop
+ \ CFRunLoopDefaultMode [
"kCFRunLoopDefaultMode" <CFString>
- dup \ CFRunLoopDefaultMode set-global
- ] when ;
+ ] initialize-alien ;
+
+TUPLE: run-loop fds sources timers ;
+
+: <run-loop> ( -- run-loop )
+ V{ } clone V{ } clone V{ } clone \ run-loop boa ;
+
+: run-loop ( -- run-loop )
+ \ run-loop [ <run-loop> ] initialize-alien ;
+
+: add-source-to-run-loop ( source -- )
+ [ run-loop sources>> push ]
+ [
+ CFRunLoopGetMain
+ swap CFRunLoopDefaultMode
+ CFRunLoopAddSource
+ ] bi ;
+
+: create-fd-source ( CFFileDescriptor -- source )
+ f swap 0 CFFileDescriptorCreateRunLoopSource ;
+
+: add-fd-to-run-loop ( fd callback -- )
+ [
+ <CFFileDescriptor> |CFRelease
+ [ run-loop fds>> push ]
+ [ create-fd-source |CFRelease add-source-to-run-loop ]
+ bi
+ ] with-destructors ;
+
+: add-timer-to-run-loop ( timer -- )
+ [ run-loop timers>> push ]
+ [
+ CFRunLoopGetMain
+ swap CFRunLoopDefaultMode
+ CFRunLoopAddTimer
+ ] bi ;
+
+<PRIVATE
+
+: ((reset-timer)) ( timer counter timestamp -- )
+ nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
+
+: (reset-timer) ( timer counter -- )
+ yield {
+ { [ dup 0 = ] [ now ((reset-timer)) ] }
+ { [ run-queue deque-empty? not ] [ 1 - (reset-timer) ] }
+ { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
+ [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
+ } cond ;
+
+: reset-timer ( timer -- )
+ 10 (reset-timer) ;
+
+PRIVATE>
+
+: reset-run-loop ( -- )
+ run-loop
+ [ timers>> [ reset-timer ] each ]
+ [ fds>> [ enable-all-callbacks ] each ] bi ;
+
+: timer-callback ( -- callback )
+ "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
+ [ 2drop reset-run-loop yield ] alien-callback ;
+
+: init-thread-timer ( -- )
+ timer-callback <CFTimer> add-timer-to-run-loop ;
+
+: run-one-iteration ( us -- handled? )
+ reset-run-loop
+ CFRunLoopDefaultMode
+ swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
+ t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;