steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

- Change alarms to run in a single spawned green thread instead of spawning a new thread for each iteration of the alarm so game.loop can use alarms -- the old behavior can be embedded by calling in-thread in your alarm handler quotation 

- Remove current-alarm dynamic variable in favor of optionally passing the alarm on the stack to the quotation
- Reschedule alarms based on a multiple of the interval from the original start time to eliminate alarm drift over time
- Clarify alarm contract in docs
- Fix later example
db4
Doug Coleman 2010-05-20 12:24:26 -05:00
parent bdecd564a3
commit 61b9f7a6d5
2 changed files with 95 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
basis/alarms/alarms-docs.factor
View File

@ -4,20 +4,6 @@ IN: alarms
HELP: alarm
{ $class-description "An alarm. Can be passed to " { $link cancel-alarm } "." } ;
HELP: current-alarm
{ $description "A symbol that contains the currently executing alarm, availble only to the alarm quotation. One use for this symbol is if a repeated alarm wishes to cancel itself from executing in the future."
}
{ $examples
{ $unchecked-example
"""USING: alarms calendar io threads ;"""
"""["""
""" "Hi, this should only get printed once..." print flush"""
""" current-alarm get cancel-alarm"""
"""] 1 seconds every"""
""
}
} ;
HELP: add-alarm
{ $values { "quot" quotation } { "start" duration } { "interval" { $maybe "duration/f" } } { "alarm" alarm } }
{ $description "Creates and registers an alarm to start at " { $snippet "start" } " offset from the current time. If " { $snippet "interval" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency, with scheduling happening before the quotation is called in order to ensure that the next event will happen on time. The quotation will be called from a new thread spawned by the alarm thread. If a repeated alarm's quotation throws an exception, the alarm will not be rescheduled." } ;
@ -28,7 +14,18 @@ HELP: later
{ $examples
{ $unchecked-example
"USING: alarms io calendar ;"
"""[ "Break's over!" print flush ] 15 minutes drop"""
"""[ "Break's over!" print flush ] 15 minutes later drop"""
""
}
} ;
HELP: later*
{ $values { "quot" quotation } { "duration" duration } { "alarm" alarm } }
{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "duration" } " offset from now. The alarm is passed to the quotation as an input." }
{ $examples
{ $unchecked-example
"USING: alarms io calendar ;"
"""[ cancel-alarm "Break's over!" print flush ] 15 minutes later* drop"""
""
}
} ;
@ -50,16 +47,28 @@ HELP: every
}
} ;
HELP: every*
{ $values
{ "quot" quotation } { "duration" duration }
{ "alarm" alarm } }
{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency. The alarm is passed as an input to the quotation. If the quotation throws an exception that is not caught inside it, the alarm scheduler will cancel the alarm and will not reschedule it again." }
{ $examples
"Cancelling an alarm from within the alarm:"
{ $unchecked-example
"USING: alarms io calendar inspector ;"
"""[ cancel-alarm "Hi Buddy." print flush ] 10 seconds every* drop"""
""
}
} ;
ARTICLE: "alarms" "Alarms"
"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread. Alarms use " { $link nano-count } ", so they continue to work across system clock changes." $nl
"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks. Alarms use " { $link nano-count } " as the timing primitive, so they will continue to work across system clock changes. Alarms run in a single green thread per alarm. If a recurring alarm's quotation would be scheduled to run again before the previous quotation has finished processing, the alarm will be run again immediately afterwards. This may result in the alarm falling behind indefinitely, in which case the it will run as often as possible while still allowing other green threads to run. Finally, recurring alarms that execute 'on time' or 'catch up' will always be scheduled for an exact multiple of the interval from the original starting time, which prevents the alarm from drifting over time." $nl
"The alarm class:"
{ $subsections alarm }
"Register a recurring alarm:"
{ $subsections every }
{ $subsections every every* }
"Register a one-time alarm:"
{ $subsections later }
"The currently executing alarm:"
{ $subsections current-alarm }
{ $subsections later later* }
"Low-level interface to add alarms:"
{ $subsections add-alarm }
"Cancelling an alarm:"

94
basis/alarms/alarms.factor
View File

@ -1,22 +1,22 @@
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs boxes calendar combinators.short-circuit
continuations fry heaps init kernel math.order
namespaces quotations threads math system ;
USING: accessors assocs calendar combinators.short-circuit fry
heaps init kernel math math.functions math.parser namespaces
quotations sequences system threads ;
IN: alarms
TUPLE: alarm
{ quot callable initial: [ ] }
{ start integer }
interval
{ entry box } ;
{ previous-iteration-begin integer }
{ iteration-begin integer }
{ stop? boolean } ;
SYMBOL: alarms
SYMBOL: alarm-thread
SYMBOL: current-alarm
: cancel-alarm ( alarm -- )
entry>> [ alarms get-global heap-delete ] if-box? ;
: cancel-alarm ( alarm -- ) t >>stop? drop ;
<PRIVATE
@ -32,33 +32,51 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
alarm new
swap >nanoseconds >>interval
swap >nanoseconds nano-count + >>start
swap >>quot
<box> >>entry ;
swap >>quot ;
: register-alarm ( alarm -- )
[ dup start>> alarms get-global heap-push* ]
[ entry>> >box ] bi
dup start>> alarms get-global heap-push* drop
notify-alarm-thread ;
: alarm-expired? ( alarm n -- ? )
[ start>> ] dip <= ;
: reschedule-alarm ( alarm -- )
dup interval>> nano-count + >>start register-alarm ;
: next-alarm-time ( alarm -- n )
! start + ceiling((now - start) / interval) * interval
nano-count
over start>> -
over interval>> / ceiling
over interval>> *
swap start>> + ; inline
DEFER: call-alarm-loop
: loop-alarm ( alarm -- )
nano-count over
[ iteration-begin>> - ] [ interval>> ] bi < [
[ next-alarm-time sleep-until ] keep
call-alarm-loop
] [
0 sleep-until call-alarm-loop
] if ;
: maybe-loop-alarm ( alarm -- )
dup { [ stop?>> ] [ interval>> not ] } 1||
[ drop ] [ loop-alarm ] if ;
: call-alarm-loop ( alarm -- )
dup stop?>> [
drop
] [
[
dup iteration-begin>> >>previous-iteration-begin
nano-count >>iteration-begin
[ ] [ quot>> ] bi call( obj -- )
] keep maybe-loop-alarm
] if ;
: call-alarm ( alarm -- )
[ entry>> box> drop ]
[ dup interval>> [ reschedule-alarm ] [ drop ] if ]
[
[ ] [ quot>> ] [ ] tri
'[
_ current-alarm
[
_ [ _ dup interval>> [ cancel-alarm ] [ drop ] if rethrow ]
recover
] with-variable
] "Alarm execution" spawn drop
] tri ;
'[ _ call-alarm-loop ] "Alarm execution" spawn drop ;
: (trigger-alarms) ( alarms n -- )
over heap-empty? [
@ -84,7 +102,7 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
: cancel-alarms ( alarms -- )
[
heap-pop-all [ nip entry>> box> drop ] assoc-each
heap-pop-all [ nip t >>stop? drop ] assoc-each
] when* ;
: init-alarms ( -- )
@ -94,11 +112,31 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
[ init-alarms ] "alarms" add-startup-hook
: drop-alarm ( quot duration -- quot' duration )
[ [ drop ] prepose ] dip ; inline
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 ;
: later ( quot duration -- alarm ) f add-alarm ;
: later* ( quot: ( alarm -- ) duration -- alarm ) f add-alarm ;
: every ( quot duration -- alarm ) dup add-alarm ;
: later ( quot: ( -- ) duration -- alarm ) drop-alarm later* ;
: every* ( quot: ( alarm -- ) duration -- alarm ) dup add-alarm ;
: every ( quot: ( -- ) duration -- alarm ) drop-alarm every* ;