- 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 runningdb4
parent
0e32dafb38
commit
b3d6ab1d3b
|
@ -11,7 +11,7 @@ TUPLE: alarm
|
||||||
delay-nanos
|
delay-nanos
|
||||||
interval-nanos
|
interval-nanos
|
||||||
iteration-start-nanos
|
iteration-start-nanos
|
||||||
{ stop? boolean }
|
quotation-running?
|
||||||
thread ;
|
thread ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -30,7 +30,10 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
|
||||||
over interval-nanos>> *
|
over interval-nanos>> *
|
||||||
over start-nanos>> +
|
over start-nanos>> +
|
||||||
over delay-nanos>> [ + ] when*
|
over delay-nanos>> [ + ] when*
|
||||||
>>iteration-start-nanos ; inline
|
>>iteration-start-nanos ;
|
||||||
|
|
||||||
|
: stop-alarm? ( alarm -- ? )
|
||||||
|
thread>> self eq? not ;
|
||||||
|
|
||||||
DEFER: call-alarm-loop
|
DEFER: call-alarm-loop
|
||||||
|
|
||||||
|
@ -39,27 +42,24 @@ DEFER: call-alarm-loop
|
||||||
[ iteration-start-nanos>> - ] [ interval-nanos>> ] bi <
|
[ iteration-start-nanos>> - ] [ interval-nanos>> ] bi <
|
||||||
[ set-next-alarm-time ] dip
|
[ set-next-alarm-time ] dip
|
||||||
[ dup iteration-start-nanos>> ] [ 0 ] if
|
[ dup iteration-start-nanos>> ] [ 0 ] if
|
||||||
sleep-until call-alarm-loop ;
|
0 or sleep-until call-alarm-loop ;
|
||||||
|
|
||||||
: maybe-loop-alarm ( alarm -- )
|
: maybe-loop-alarm ( alarm -- )
|
||||||
dup { [ stop?>> ] [ interval-nanos>> not ] } 1||
|
dup { [ stop-alarm? ] [ interval-nanos>> not ] } 1||
|
||||||
[ drop ] [ loop-alarm ] if ;
|
[ drop ] [ loop-alarm ] if ;
|
||||||
|
|
||||||
: call-alarm-loop ( alarm -- )
|
: call-alarm-loop ( alarm -- )
|
||||||
dup stop?>> [
|
dup stop-alarm? [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
[ quot>> call( -- ) ] keep
|
[
|
||||||
|
[ t >>quotation-running? drop ]
|
||||||
|
[ quot>> call( -- ) ]
|
||||||
|
[ f >>quotation-running? drop ] tri
|
||||||
|
] keep
|
||||||
maybe-loop-alarm
|
maybe-loop-alarm
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: call-alarm ( alarm -- )
|
|
||||||
'[
|
|
||||||
_ self >>thread
|
|
||||||
[ delay-nanos>> [ sleep ] when* ]
|
|
||||||
[ nano-count >>iteration-start-nanos call-alarm-loop ] bi
|
|
||||||
] "Alarm execution" spawn drop ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: <alarm> ( quot delay-duration/f interval-duration/f -- alarm )
|
: <alarm> ( quot delay-duration/f interval-duration/f -- alarm )
|
||||||
|
@ -69,14 +69,20 @@ PRIVATE>
|
||||||
swap >>quot ; inline
|
swap >>quot ; inline
|
||||||
|
|
||||||
: start-alarm ( alarm -- )
|
: 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 -- )
|
: stop-alarm ( alarm -- )
|
||||||
t >>stop?
|
dup quotation-running?>> [
|
||||||
f >>start-nanos
|
f >>thread drop
|
||||||
drop ;
|
] [
|
||||||
|
[ [ interrupt ] when* f ] change-thread drop
|
||||||
|
] if ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue