134 lines
3.4 KiB
Factor
134 lines
3.4 KiB
Factor
! Copyright (C) 2008, 2010 Slava Pestov
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors alien alien.c-types alien.syntax kernel math
|
|
namespaces sequences destructors combinators threads heaps
|
|
deques calendar system core-foundation core-foundation.strings
|
|
core-foundation.file-descriptors core-foundation.timers
|
|
core-foundation.time ;
|
|
IN: core-foundation.run-loop
|
|
|
|
CONSTANT: kCFRunLoopRunFinished 1
|
|
CONSTANT: kCFRunLoopRunStopped 2
|
|
CONSTANT: kCFRunLoopRunTimedOut 3
|
|
CONSTANT: kCFRunLoopRunHandledSource 4
|
|
|
|
TYPEDEF: void* CFRunLoopRef
|
|
TYPEDEF: void* CFRunLoopSourceRef
|
|
|
|
FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;
|
|
FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( ) ;
|
|
|
|
FUNCTION: SInt32 CFRunLoopRunInMode (
|
|
CFStringRef mode,
|
|
CFTimeInterval seconds,
|
|
Boolean returnAfterSourceHandled
|
|
) ;
|
|
|
|
FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource (
|
|
CFAllocatorRef allocator,
|
|
CFFileDescriptorRef f,
|
|
CFIndex order
|
|
) ;
|
|
|
|
FUNCTION: void CFRunLoopAddSource (
|
|
CFRunLoopRef rl,
|
|
CFRunLoopSourceRef source,
|
|
CFStringRef mode
|
|
) ;
|
|
|
|
FUNCTION: void CFRunLoopRemoveSource (
|
|
CFRunLoopRef rl,
|
|
CFRunLoopSourceRef source,
|
|
CFStringRef mode
|
|
) ;
|
|
|
|
FUNCTION: void CFRunLoopAddTimer (
|
|
CFRunLoopRef rl,
|
|
CFRunLoopTimerRef timer,
|
|
CFStringRef mode
|
|
) ;
|
|
|
|
FUNCTION: void CFRunLoopRemoveTimer (
|
|
CFRunLoopRef rl,
|
|
CFRunLoopTimerRef timer,
|
|
CFStringRef mode
|
|
) ;
|
|
|
|
CFSTRING: CFRunLoopDefaultMode "kCFRunLoopDefaultMode"
|
|
|
|
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 ;
|
|
|
|
: invalidate-run-loop-timers ( -- )
|
|
run-loop [
|
|
[ [ CFRunLoopTimerInvalidate ] [ CFRelease ] bi ] each
|
|
V{ } clone
|
|
] change-timers drop ;
|
|
|
|
<PRIVATE
|
|
|
|
: (reset-timer) ( timer timestamp -- )
|
|
>CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
|
|
|
|
: nano-count>micros ( x -- n )
|
|
nano-count - 1,000 /f system-micros + ;
|
|
|
|
: reset-timer ( timer -- )
|
|
yield {
|
|
{ [ run-queue deque-empty? not ] [ yield system-micros (reset-timer) ] }
|
|
{ [ sleep-queue heap-empty? ] [ system-micros 1,000,000 + (reset-timer) ] }
|
|
[ sleep-queue heap-peek nip nano-count>micros (reset-timer) ]
|
|
} cond ;
|
|
|
|
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 ( nanos -- handled? )
|
|
reset-run-loop
|
|
CFRunLoopDefaultMode
|
|
swap [ nanoseconds ] [ 5 minutes ] if* >CFTimeInterval
|
|
t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;
|