core-foundation.run-loop: clean up and speed up some code to fix star…

…vation issue exposed by game.loop (reported by Joe Groff)

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

@@ -99,23 +99,19 @@ TUPLE: run-loop fds sources timers ;
 
 <PRIVATE
 
-: ((reset-timer)) ( timer counter timestamp -- )
-    nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
+: (reset-timer) ( timer timestamp -- )
+    >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
 
-: nano-count>timestamp ( x -- timestamp )
-    nano-count - nanoseconds now time+ ;
+: nano-count>micros ( x -- n )
+    nano-count - 1,000 /f system-micros + ;
 
-: (reset-timer) ( timer counter -- )
+: reset-timer ( timer -- )
     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 nano-count>timestamp ((reset-timer)) ]
+        { [ run-queue deque-empty? not ] [ yield system-micros (reset-timer) ] }
+        { [ sleep-queue heap-empty? ] [ system-micros 1,000,000 + (reset-timer) ] }
+        [ sleep-queue heap-peek nip nano-count>micros (reset-timer) ]
     } cond ;
 
-: reset-timer ( timer -- )
-    10 (reset-timer) ;
-
 PRIVATE>
 
 : reset-run-loop ( -- )

basis/core-foundation/time/time.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: calendar alien.c-types alien.syntax ;
+USING: calendar math alien.c-types alien.syntax memoize system ;
 IN: core-foundation.time
 
 TYPEDEF: double CFTimeInterval
@@ -9,6 +9,8 @@ TYPEDEF: double CFAbsoluteTime
 : >CFTimeInterval ( duration -- interval )
     duration>seconds ; inline
 
-: >CFAbsoluteTime ( timestamp -- time )
-    T{ timestamp { year 2001 } { month 1 } { day 1 } } time-
-    duration>seconds ; inline
+MEMO: epoch ( -- micros )
+    T{ timestamp { year 2001 } { month 1 } { day 1 } } timestamp>micros ;
+
+: >CFAbsoluteTime ( micros -- time )
+    epoch - 1,000,000 /f ; inline

basis/core-foundation/timers/timers.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.syntax system math kernel calendar
 core-foundation core-foundation.time ;
@@ -19,7 +19,7 @@ FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate (
 ) ;
 
 : <CFTimer> ( callback -- timer )
-    [ f now >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ;
+    [ f system-micros >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ;
 
 FUNCTION: void CFRunLoopTimerInvalidate (
    CFRunLoopTimerRef timer

extra/game/loop/loop.factor

@@ -66,7 +66,7 @@ TUPLE: game-loop-error game-loop error ;
 
 : (run-loop) ( loop -- )
     dup running?>>
-    [ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] [ 1 milliseconds sleep (run-loop) ] tri ]
+    [ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] [ yield (run-loop) ] tri ]
     [ drop ] if ;
 
 : run-loop ( loop -- )