From f3c9eab1f521ec88a924e576affa5e126a7e5472 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 21 May 2010 13:19:15 -0500
Subject: [PATCH] Simplify the alarms implementation a bit

---
 basis/alarms/alarms.factor | 34 ++++++++++------------------------
 1 file changed, 10 insertions(+), 24 deletions(-)

diff --git a/basis/alarms/alarms.factor b/basis/alarms/alarms.factor
index cd8d1e3159..1824e1efec 100644
--- a/basis/alarms/alarms.factor
+++ b/basis/alarms/alarms.factor
@@ -9,8 +9,7 @@ TUPLE: alarm
     { quot callable initial: [ ] }
     { start integer }
     interval
-    { previous-iteration-begin integer }
-    { iteration-begin integer }
+    { iteration-scheduled integer }
     { stop? boolean } ;
 
 SYMBOL: alarms
@@ -31,8 +30,9 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
 : <alarm> ( quot start interval -- alarm )
     alarm new
         swap >nanoseconds >>interval
-        swap >nanoseconds nano-count + >>start
-        swap >>quot ;
+        swap >nanoseconds nano-count +
+            [ >>start ] [ >>iteration-scheduled ] bi
+        swap >>quot ; inline
 
 : register-alarm ( alarm -- )
     dup start>> alarms get-global heap-push* drop
@@ -41,21 +41,22 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
 : alarm-expired? ( alarm n -- ? )
     [ start>> ] dip <= ;
 
-: next-alarm-time ( alarm -- n )
+: set-next-alarm-time ( alarm -- alarm )
     ! start + ceiling((now - start) / interval) * interval
     nano-count 
     over start>> -
     over interval>> / ceiling
     over interval>> *
-    swap start>> + ; inline
+    over start>> + >>iteration-scheduled ; inline
 
 DEFER: call-alarm-loop
 
 : loop-alarm ( alarm -- )
     nano-count over
-    [ iteration-begin>> - ] [ interval>> ] bi < [
-        [ next-alarm-time sleep-until ] keep
-        call-alarm-loop
+    [ iteration-scheduled>> - ] [ interval>> ] bi <
+    [ set-next-alarm-time ] dip [
+        [ iteration-scheduled>> sleep-until ]
+        [ call-alarm-loop ] bi
     ] [
         0 sleep-until call-alarm-loop
     ] if ;
@@ -69,8 +70,6 @@ DEFER: call-alarm-loop
         drop
     ] [
         [
-            dup iteration-begin>> >>previous-iteration-begin
-            nano-count >>iteration-begin
             [ ] [ quot>> ] bi call( obj -- )
         ] keep maybe-loop-alarm
     ] if ;
@@ -117,19 +116,6 @@ DEFER: call-alarm-loop
 
 PRIVATE>
 
-: alarm-overdue ( alarm -- n/f )
-    dup { [ interval>> not ] [ previous-iteration-begin>> 0 = ] } 1|| [
-        drop f
-    ] [
-        [ iteration-begin>> ]
-        [ previous-iteration-begin>> - ]
-        [ interval>> ] tri 2dup >= [
-            nip
-        ] [
-            2drop f
-        ] if
-    ] if ;
-
 : add-alarm ( quot start interval -- alarm )
     <alarm> [ register-alarm ] keep ;