store the current alarm in current-alarm
parent
a0b13cdb2c
commit
a37908e00e
|
@ -13,6 +13,7 @@ TUPLE: alarm
|
||||||
|
|
||||||
SYMBOL: alarms
|
SYMBOL: alarms
|
||||||
SYMBOL: alarm-thread
|
SYMBOL: alarm-thread
|
||||||
|
SYMBOL: current-alarm
|
||||||
|
|
||||||
: cancel-alarm ( alarm -- )
|
: cancel-alarm ( alarm -- )
|
||||||
entry>> [ alarms get-global heap-delete ] if-box? ;
|
entry>> [ alarms get-global heap-delete ] if-box? ;
|
||||||
|
@ -49,9 +50,14 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
|
||||||
[ entry>> box> drop ]
|
[ entry>> box> drop ]
|
||||||
[ dup interval>> [ reschedule-alarm ] [ drop ] if ]
|
[ dup interval>> [ reschedule-alarm ] [ drop ] if ]
|
||||||
[
|
[
|
||||||
[ quot>> ] [ ] bi
|
[ ] [ quot>> ] [ ] tri
|
||||||
'[ _ [ _ dup interval>> [ cancel-alarm ] [ drop ] if rethrow ] recover ]
|
'[
|
||||||
"Alarm execution" spawn drop
|
_ current-alarm
|
||||||
|
[
|
||||||
|
_ [ _ dup interval>> [ cancel-alarm ] [ drop ] if rethrow ]
|
||||||
|
recover
|
||||||
|
] with-variable
|
||||||
|
] "Alarm execution" spawn drop
|
||||||
] tri ;
|
] tri ;
|
||||||
|
|
||||||
: (trigger-alarms) ( alarms n -- )
|
: (trigger-alarms) ( alarms n -- )
|
||||||
|
|
Loading…
Reference in New Issue