Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / core-foundation / run-loop / run-loop.factor

diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor
index e30cc2eb6013141d3d8b139f4355901fcf430b4f..6446eacd08045d3cf91e9e485a0f5c8a22ad3829 100644 (file)
--- a/basis/core-foundation/run-loop/run-loop.factor
+++ b/basis/core-foundation/run-loop/run-loop.factor
@@ -1,37 +1,132 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel threads init namespaces alien
-core-foundation ;
+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
+core-foundation.time ;
 IN: core-foundation.run-loop
 
-: kCFRunLoopRunFinished 1 ; inline
-: kCFRunLoopRunStopped 2 ; inline
-: kCFRunLoopRunTimedOut 3 ; inline
-: kCFRunLoopRunHandledSource 4 ; inline
+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
+    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
 ) ;
 
 : CFRunLoopDefaultMode ( -- alien )
     #! Ugly, but we don't have static NSStrings
-    \ CFRunLoopDefaultMode get-global dup expired? [
-        drop
+    \ CFRunLoopDefaultMode [
         "kCFRunLoopDefaultMode" <CFString>
-        dup \ CFRunLoopDefaultMode set-global
-    ] when ;
+    ] initialize-alien ;
+
+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 ;
+
+<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 ;
 
-: run-loop-thread ( -- )
-    CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
-    kCFRunLoopRunHandledSource = [ 1000 sleep ] unless
-    run-loop-thread ;
+: init-thread-timer ( -- )
+    timer-callback <CFTimer> add-timer-to-run-loop ;
 
-: start-run-loop-thread ( -- )
-    [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
+: run-one-iteration ( us -- handled? )
+    reset-run-loop
+    CFRunLoopDefaultMode
+    swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
+    t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;