steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
basis/core-foundation/run-loop/run-loop.factor
View File

@ -80,25 +80,12 @@ TUPLE: run-loop fds sources timers ;
: add-fd-to-run-loop ( fd callback -- ) : add-fd-to-run-loop ( fd callback -- )
[ [
<CFFileDescriptor> |CFRelease <CFFileDescriptor> |CFRelease
[ enable-all-callbacks ]
[ run-loop fds>> push ] [ run-loop fds>> push ]
[ create-fd-source |CFRelease add-source-to-run-loop ] [ create-fd-source |CFRelease add-source-to-run-loop ]
bi tri
] with-destructors ; ] 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 <PRIVATE
: (reset-timer) ( timer timestamp -- ) : (reset-timer) ( timer timestamp -- )
@ -111,6 +98,21 @@ TUPLE: run-loop fds sources timers ;
PRIVATE> 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 ( -- ) : reset-run-loop ( -- )
run-loop run-loop
[ timers>> [ reset-timer ] each ] [ timers>> [ reset-timer ] each ]
@ -118,13 +120,12 @@ PRIVATE>
: timer-callback ( -- callback ) : timer-callback ( -- callback )
void { CFRunLoopTimerRef void* } cdecl void { CFRunLoopTimerRef void* } cdecl
[ 2drop reset-run-loop yield ] alien-callback ; [ drop reset-timer yield ] alien-callback ;
: init-thread-timer ( -- ) : init-thread-timer ( -- )
60 timer-callback <CFTimer> add-timer-to-run-loop ; 60 timer-callback <CFTimer> add-timer-to-run-loop ;
: run-one-iteration ( nanos -- handled? ) : run-one-iteration ( nanos -- handled? )
reset-run-loop
CFRunLoopDefaultMode CFRunLoopDefaultMode
swap [ nanoseconds ] [ 5 minutes ] if* >CFTimeInterval swap [ nanoseconds ] [ 5 minutes ] if* >CFTimeInterval
t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ; t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;

3
basis/io/backend/unix/multiplexers/run-loop/run-loop.factor
View File

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