! 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
"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 = ;
! 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 ;
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 ;