From b3d6ab1d3b122689b3f229bfa3cc7b4ba17071b1 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 23 May 2010 22:25:17 -0500
Subject: [PATCH] - Remove the alarms stop variable, and instead for a stop
 condition, check against the thread object being replaced. - Interrupt the
 thread sleep when stopped, but only if the quotation is not currently running

---
 basis/alarms/alarms.factor | 44 ++++++++++++++++++++++----------------
 1 file changed, 25 insertions(+), 19 deletions(-)

diff --git a/basis/alarms/alarms.factor b/basis/alarms/alarms.factor
index e77371954f..a82f367a13 100644
--- a/basis/alarms/alarms.factor
+++ b/basis/alarms/alarms.factor
@@ -11,7 +11,7 @@ TUPLE: alarm
     delay-nanos
     interval-nanos
     iteration-start-nanos
-    { stop? boolean }
+    quotation-running?
     thread ;
 
 <PRIVATE
@@ -30,7 +30,10 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
     over interval-nanos>> *
     over start-nanos>> +
     over delay-nanos>> [ + ] when*
-    >>iteration-start-nanos ; inline
+    >>iteration-start-nanos ;
+
+: stop-alarm? ( alarm -- ? )
+    thread>> self eq? not ;
 
 DEFER: call-alarm-loop
 
@@ -39,27 +42,24 @@ DEFER: call-alarm-loop
     [ iteration-start-nanos>> - ] [ interval-nanos>> ] bi <
     [ set-next-alarm-time ] dip
     [ dup iteration-start-nanos>> ] [ 0 ] if
-    sleep-until call-alarm-loop ;
+    0 or sleep-until call-alarm-loop ;
 
 : maybe-loop-alarm ( alarm -- )
-    dup { [ stop?>> ] [ interval-nanos>> not ] } 1||
+    dup { [ stop-alarm? ] [ interval-nanos>> not ] } 1||
     [ drop ] [ loop-alarm ] if ;
 
 : call-alarm-loop ( alarm -- )
-    dup stop?>> [
+    dup stop-alarm? [
         drop
     ] [
-        [ quot>> call( -- ) ] keep
+        [
+            [ t >>quotation-running? drop ]
+            [ quot>> call( -- ) ]
+            [ f >>quotation-running? drop ] tri
+        ] keep
         maybe-loop-alarm
     ] if ;
 
-: call-alarm ( alarm -- )
-    '[
-        _ self >>thread
-        [ delay-nanos>> [ sleep ] when* ]
-        [ nano-count >>iteration-start-nanos call-alarm-loop ] bi
-    ] "Alarm execution" spawn drop ;
-
 PRIVATE>
 
 : <alarm> ( quot delay-duration/f interval-duration/f -- alarm )
@@ -69,14 +69,20 @@ PRIVATE>
         swap >>quot ; inline
 
 : start-alarm ( alarm -- )
-    f >>stop?
-    nano-count >>start-nanos
-    call-alarm ;
+    [
+        '[
+            _ nano-count >>start-nanos
+            [ delay-nanos>> [ sleep ] when* ]
+            [ nano-count >>iteration-start-nanos call-alarm-loop ] bi
+        ] "Alarm execution" spawn
+    ] keep thread<< ;
 
 : stop-alarm ( alarm -- )
-    t >>stop?
-    f >>start-nanos
-    drop ;
+    dup quotation-running?>> [
+        f >>thread drop
+    ] [
+        [ [ interrupt ] when* f ] change-thread drop
+    ] if ;
 
 <PRIVATE