core-foundation.run-loop: do less work, speeds up yield by 50%.

db4
John Benediktsson 2012-08-01 10:57:58 -07:00
parent a61ea18ad7
commit 3e6e6458e5
2 changed files with 19 additions and 19 deletions

View File

@ -80,25 +80,12 @@ TUPLE: run-loop fds sources timers ;
: add-fd-to-run-loop ( fd callback -- )
[
<CFFileDescriptor> |CFRelease
[ enable-all-callbacks ]
[ run-loop fds>> push ]
[ create-fd-source |CFRelease add-source-to-run-loop ]
bi
tri
] 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 -- )
@ -111,6 +98,21 @@ TUPLE: run-loop fds sources timers ;
PRIVATE>
: add-timer-to-run-loop ( timer -- )
[ reset-timer ]
[ run-loop timers>> push ]
[
CFRunLoopGetMain
swap CFRunLoopDefaultMode
CFRunLoopAddTimer
] tri ;
: invalidate-run-loop-timers ( -- )
run-loop [
[ [ CFRunLoopTimerInvalidate ] [ CFRelease ] bi ] each
V{ } clone
] change-timers drop ;
: reset-run-loop ( -- )
run-loop
[ timers>> [ reset-timer ] each ]
@ -118,13 +120,12 @@ PRIVATE>
: timer-callback ( -- callback )
void { CFRunLoopTimerRef void* } cdecl
[ 2drop reset-run-loop yield ] alien-callback ;
[ drop reset-timer yield ] alien-callback ;
: init-thread-timer ( -- )
60 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 = ;

View File

@ -12,9 +12,8 @@ TUPLE: run-loop-mx kqueue-mx ;
: file-descriptor-callback ( -- callback )
void { CFFileDescriptorRef CFOptionFlags void* }
cdecl [
3drop
2drop enable-all-callbacks
0 mx get kqueue-mx>> wait-for-events
reset-run-loop
yield
] alien-callback ;