Clean up run loop I/O multiplexer and make most of it independent of the I/O system; the UI will use it too
parent
bb45fa93a7
commit
5ecffec1b9
|
@ -1,8 +1,9 @@
|
|||
! 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 ;
|
||||
IN: core-foundation.run-loop
|
||||
|
||||
: kCFRunLoopRunFinished 1 ; inline
|
||||
|
@ -59,3 +60,80 @@ FUNCTION: void CFRunLoopRemoveTimer (
|
|||
"kCFRunLoopDefaultMode" <CFString>
|
||||
dup \ CFRunLoopDefaultMode set-global
|
||||
] when ;
|
||||
|
||||
TUPLE: run-loop fds sources timers ;
|
||||
|
||||
: <run-loop> ( -- run-loop )
|
||||
V{ } clone V{ } clone V{ } clone \ run-loop boa ;
|
||||
|
||||
SYMBOL: expiry-check
|
||||
|
||||
: run-loop ( -- run-loop )
|
||||
\ run-loop get-global not expiry-check get expired? or
|
||||
[
|
||||
31337 <alien> expiry-check set-global
|
||||
<run-loop> dup \ run-loop set-global
|
||||
] [ \ run-loop get-global ] if ;
|
||||
|
||||
: 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 = ;
|
||||
|
|
|
@ -1,50 +1,27 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces math accessors threads alien locals
|
||||
destructors combinators io.unix.multiplexers
|
||||
USING: kernel arrays namespaces math accessors alien locals
|
||||
destructors system threads io.unix.multiplexers
|
||||
io.unix.multiplexers.kqueue core-foundation
|
||||
core-foundation.run-loop core-foundation.file-descriptors ;
|
||||
core-foundation.run-loop ;
|
||||
IN: io.unix.multiplexers.run-loop
|
||||
|
||||
TUPLE: run-loop-mx kqueue-mx fd source ;
|
||||
TUPLE: run-loop-mx kqueue-mx ;
|
||||
|
||||
: kqueue-callback ( -- callback )
|
||||
: file-descriptor-callback ( -- callback )
|
||||
"void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" }
|
||||
"cdecl" [
|
||||
3drop
|
||||
0 mx get kqueue-mx>> wait-for-events
|
||||
mx get fd>> enable-all-callbacks
|
||||
reset-run-loop
|
||||
yield
|
||||
]
|
||||
alien-callback ;
|
||||
|
||||
SYMBOL: kqueue-run-loop-source
|
||||
|
||||
: create-kqueue-source ( fd -- source )
|
||||
f swap 0 CFFileDescriptorCreateRunLoopSource ;
|
||||
|
||||
: add-kqueue-to-run-loop ( mx -- )
|
||||
CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopAddSource ;
|
||||
|
||||
: remove-kqueue-from-run-loop ( source -- )
|
||||
CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopRemoveSource ;
|
||||
] alien-callback ;
|
||||
|
||||
: <run-loop-mx> ( -- mx )
|
||||
[
|
||||
<kqueue-mx> |dispose
|
||||
dup fd>> kqueue-callback <CFFileDescriptor> |dispose
|
||||
dup create-kqueue-source run-loop-mx boa
|
||||
dup add-kqueue-to-run-loop
|
||||
] with-destructors ;
|
||||
|
||||
M: run-loop-mx dispose
|
||||
[
|
||||
{
|
||||
[ fd>> &CFRelease drop ]
|
||||
[ source>> &CFRelease drop ]
|
||||
[ remove-kqueue-from-run-loop ]
|
||||
[ kqueue-mx>> &dispose drop ]
|
||||
} cleave
|
||||
dup fd>> file-descriptor-callback add-fd-to-run-loop
|
||||
run-loop-mx boa
|
||||
] with-destructors ;
|
||||
|
||||
M: run-loop-mx add-input-callback kqueue-mx>> add-input-callback ;
|
||||
|
@ -52,7 +29,5 @@ M: run-loop-mx add-output-callback kqueue-mx>> add-output-callback ;
|
|||
M: run-loop-mx remove-input-callbacks kqueue-mx>> remove-input-callbacks ;
|
||||
M: run-loop-mx remove-output-callbacks kqueue-mx>> remove-output-callbacks ;
|
||||
|
||||
M:: run-loop-mx wait-for-events ( us mx -- )
|
||||
mx fd>> enable-all-callbacks
|
||||
CFRunLoopDefaultMode us [ 1000000 /f ] [ 60 ] if* t CFRunLoopRunInMode
|
||||
kCFRunLoopRunHandledSource = [ 0 mx wait-for-events ] when ;
|
||||
M: run-loop-mx wait-for-events ( us mx -- )
|
||||
swap run-one-iteration [ 0 swap wait-for-events ] [ drop ] if ;
|
||||
|
|
Loading…
Reference in New Issue