Clean up run loop I/O multiplexer and make most of it independent of the I/O system; the UI will use it too

basis/core-foundation/run-loop/run-loop.factor

@@ -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
+USING: accessors alien alien.syntax kernel math namespaces
-core-foundation.strings core-foundation.file-descriptors
+sequences destructors combinators threads heaps deques calendar
-core-foundation.timers ;
+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 = ;

basis/io/unix/multiplexers/run-loop/run-loop.factor

@@ -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
+USING: kernel arrays namespaces math accessors alien locals
-destructors combinators io.unix.multiplexers
+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 ;
-    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 ;
 
 : <run-loop-mx> ( -- mx )
     [
         <kqueue-mx> |dispose
-        dup fd>> kqueue-callback <CFFileDescriptor> |dispose
+        dup fd>> file-descriptor-callback add-fd-to-run-loop
-        dup create-kqueue-source run-loop-mx boa
+        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
     ] 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 -- )
+M: run-loop-mx wait-for-events ( us mx -- )
-    mx fd>> enable-all-callbacks
+    swap run-one-iteration [ 0 swap wait-for-events ] [ drop ] if ;
-    CFRunLoopDefaultMode us [ 1000000 /f ] [ 60 ] if* t CFRunLoopRunInMode
-    kCFRunLoopRunHandledSource = [ 0 mx wait-for-events ] when ;