IN: alarms\r
\r
HELP: alarm\r
-{ $class-description "An alarm. Can be passed to " { $link cancel-alarm } "." } ;\r
+{ $class-description "An alarm. Can be passed to " { $link stop-alarm } "." } ;\r
\r
-HELP: add-alarm\r
-{ $values { "quot" quotation } { "start" duration } { "interval" { $maybe "duration/f" } } { "alarm" alarm } }\r
-{ $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." } ;\r
+HELP: start-alarm\r
+{ $values { "alarm" alarm } }\r
+{ $description "Starts an alarm." } ;\r
\r
-HELP: later\r
-{ $values { "quot" quotation } { "duration" duration } { "alarm" alarm } }\r
-{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "duration" } " offset from now." }\r
+HELP: stop-alarm\r
+{ $values { "alarm" alarm } }\r
+{ $description "Prevents an alarm from calling its quotation again. Has no effect on alarms that are not currently running." } ;\r
+\r
+HELP: every\r
+{ $values\r
+ { "quot" quotation } { "interval-duration" duration }\r
+ { "alarm" alarm } }\r
+{ $description "Creates an alarm that calls the quotation repeatedly, using " { $snippet "duration" } " as the frequency. The first call of " { $snippet "quot" } " will happen immediately. If the quotation throws an exception, the alarm will stop." }\r
{ $examples\r
{ $unchecked-example\r
"USING: alarms io calendar ;"\r
- """[ "Break's over!" print flush ] 15 minutes later drop"""\r
+ """[ "Hi Buddy." print flush ] 10 seconds every drop"""\r
""\r
}\r
} ;\r
\r
-HELP: later*\r
-{ $values { "quot" quotation } { "duration" duration } { "alarm" alarm } }\r
-{ $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." }\r
+HELP: later\r
+{ $values { "quot" quotation } { "delay-duration" duration } { "alarm" alarm } }\r
+{ $description "Sleeps for " { $snippet "duration" } " and then calls a " { $snippet "quot" } ". The user may cancel the alarm before " { $snippet "quot" } " runs. This alarm is not repeated." }\r
{ $examples\r
{ $unchecked-example\r
"USING: alarms io calendar ;"\r
- """[ cancel-alarm "Break's over!" print flush ] 15 minutes later* drop"""\r
+ """[ "Break's over!" print flush ] 15 minutes later drop"""\r
""\r
}\r
} ;\r
\r
-HELP: cancel-alarm\r
-{ $values { "alarm" alarm } }\r
-{ $description "Cancels an alarm. Does nothing if the alarm is not active." } ;\r
-\r
-HELP: every\r
+HELP: delayed-every\r
{ $values\r
{ "quot" quotation } { "duration" duration }\r
{ "alarm" alarm } }\r
-{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency. 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." }\r
+{ $description "Creates an alarm that calls " { $snippet "quot" } " repeatedly, waiting " { $snippet "duration" } " before calling " { $snippet "quot" } " the first time and then waiting " { $snippet "duration" } " between further calls. If the quotation throws an exception, the alarm will stop." }\r
{ $examples\r
{ $unchecked-example\r
"USING: alarms io calendar ;"\r
}\r
} ;\r
\r
-HELP: every*\r
-{ $values\r
- { "quot" quotation } { "duration" duration }\r
- { "alarm" alarm } }\r
-{ $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." }\r
-{ $examples\r
- "Cancelling an alarm from within the alarm:"\r
- { $unchecked-example\r
- "USING: alarms io calendar inspector ;"\r
- """[ cancel-alarm "Hi Buddy." print flush ] 10 seconds every* drop"""\r
- ""\r
- }\r
-} ;\r
-\r
ARTICLE: "alarms" "Alarms"\r
-"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\r
+"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. 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. Generally, alarms have a delay duration and an interval duration. Starting an alarm first waits out the delay duration, and then waits out the interval duration for every call thereafter. Alarms do not persist across saving and loading an image." $nl\r
"The alarm class:"\r
{ $subsections alarm }\r
-"Register a recurring alarm:"\r
-{ $subsections every every* }\r
-"Register a one-time alarm:"\r
-{ $subsections later later* }\r
-"Low-level interface to add alarms:"\r
-{ $subsections add-alarm }\r
-"Cancelling an alarm:"\r
-{ $subsections cancel-alarm }\r
-"Alarms do not persist across image saves. Saving and restoring an image has the effect of calling " { $link cancel-alarm } " on all " { $link alarm } " instances." ;\r
+"Create an alarm before starting it:"\r
+{ $subsections <alarm> }\r
+"Starting an alarm:"\r
+{ $subsections start-alarm }\r
+"Stopping an alarm:"\r
+{ $subsections stop-alarm }\r
+\r
+"A recurring alarm without an initial delay:"\r
+{ $subsections every }\r
+"A one-time alarm with an initial delay:"\r
+{ $subsections later }\r
+"A recurring alarm with an initial delay:"\r
+{ $subsections delayed-every } ;\r
\r
ABOUT: "alarms"\r
TUPLE: alarm
{ quot callable initial: [ ] }
- { start integer }
- interval
- { iteration-scheduled integer }
+ start-nanos
+ delay-nanos
+ interval-nanos integer
+ { next-iteration-nanos integer }
{ stop? boolean } ;
-SYMBOL: alarms
-SYMBOL: alarm-thread
-
-: cancel-alarm ( alarm -- ) t >>stop? drop ;
-
<PRIVATE
-: notify-alarm-thread ( -- )
- alarm-thread get-global interrupt ;
-
GENERIC: >nanoseconds ( obj -- duration/f )
M: f >nanoseconds ;
M: real >nanoseconds >integer ;
M: duration >nanoseconds duration>nanoseconds >integer ;
-: <alarm> ( quot start interval -- alarm )
- alarm new
- swap >nanoseconds >>interval
- nano-count >>start
- swap >nanoseconds over start>> + >>iteration-scheduled
- swap >>quot ; inline
-
-: register-alarm ( alarm -- )
- dup iteration-scheduled>> alarms get-global heap-push* drop
- notify-alarm-thread ;
-
-: alarm-expired? ( alarm n -- ? )
- [ start>> ] dip <= ;
-
: set-next-alarm-time ( alarm -- alarm )
- ! start + ceiling((now - start) / interval) * interval
+ ! start + delay + ceiling((now - start) / interval) * interval
nano-count
- over start>> -
- over interval>> / ceiling
- over interval>> *
- over start>> + >>iteration-scheduled ; inline
+ over start-nanos>> -
+ over delay-nanos>> [ + ] when*
+ over interval-nanos>> / ceiling
+ over interval-nanos>> *
+ over start-nanos>> + >>next-iteration-nanos ; inline
DEFER: call-alarm-loop
: loop-alarm ( alarm -- )
nano-count over
- [ iteration-scheduled>> - ] [ interval>> ] bi <
- [ set-next-alarm-time ] dip [
- [ iteration-scheduled>> sleep-until ]
- [ call-alarm-loop ] bi
- ] [
- 0 sleep-until call-alarm-loop
- ] if ;
+ [ next-iteration-nanos>> - ] [ interval-nanos>> ] bi <
+ [ set-next-alarm-time ] dip
+ [ dup next-iteration-nanos>> ] [ 0 ] if
+ sleep-until call-alarm-loop ;
: maybe-loop-alarm ( alarm -- )
- dup { [ stop?>> ] [ interval>> not ] } 1||
+ dup { [ stop?>> ] [ interval-nanos>> not ] } 1||
[ drop ] [ loop-alarm ] if ;
: call-alarm-loop ( alarm -- )
dup stop?>> [
drop
] [
- [
- [ ] [ quot>> ] bi call( obj -- )
- ] keep maybe-loop-alarm
+ [ quot>> call( -- ) ] keep
+ maybe-loop-alarm
] if ;
: call-alarm ( alarm -- )
- '[ _ call-alarm-loop ] "Alarm execution" spawn drop ;
+ [ delay-nanos>> ] [ ] bi
+ '[ _ [ sleep ] when* _ call-alarm-loop ] "Alarm execution" spawn drop ;
-: (trigger-alarms) ( alarms n -- )
- over heap-empty? [
- 2drop
- ] [
- over heap-peek drop over alarm-expired? [
- over heap-pop drop call-alarm (trigger-alarms)
- ] [
- 2drop
- ] if
- ] if ;
-
-: trigger-alarms ( alarms -- )
- nano-count (trigger-alarms) ;
-
-: next-alarm ( alarms -- nanos/f )
- dup heap-empty? [ drop f ] [ heap-peek drop start>> ] if ;
+PRIVATE>
-: alarm-thread-loop ( -- )
- alarms get-global
- dup next-alarm sleep-until
- trigger-alarms ;
+: <alarm> ( quot delay-duration/f interval-duration/f -- alarm )
+ alarm new
+ swap >nanoseconds >>interval-nanos
+ swap >nanoseconds >>delay-nanos
+ swap >>quot ; inline
-: cancel-alarms ( alarms -- )
- [
- heap-pop-all [ nip t >>stop? drop ] assoc-each
- ] when* ;
+: start-alarm ( alarm -- )
+ f >>stop?
+ nano-count >>start-nanos
+ call-alarm ;
-: init-alarms ( -- )
- alarms [ cancel-alarms <min-heap> ] change-global
- [ alarm-thread-loop t ] "Alarms" spawn-server
- alarm-thread set-global ;
+: stop-alarm ( alarm -- )
+ t >>stop?
+ f >>start-nanos
+ drop ;
-[ init-alarms ] "alarms" add-startup-hook
+<PRIVATE
-: drop-alarm ( quot duration -- quot' duration )
- [ [ drop ] prepose ] dip ; inline
+: (start-alarm) ( quot start-duration interval-duration -- alarm )
+ <alarm> [ start-alarm ] keep ;
PRIVATE>
-: add-alarm ( quot start interval -- alarm )
- <alarm> [ register-alarm ] keep ;
-
-: later* ( quot: ( alarm -- ) duration -- alarm ) f add-alarm ;
-
-: later ( quot: ( -- ) duration -- alarm ) drop-alarm later* ;
+: every ( quot interval-duration -- alarm )
+ [ f ] dip (start-alarm) ;
-: every* ( quot: ( alarm -- ) duration -- alarm ) dup add-alarm ;
+: later ( quot delay-duration -- alarm )
+ f (start-alarm) ;
-: every ( quot: ( -- ) duration -- alarm ) drop-alarm every* ;
+: delayed-every ( quot duration -- alarm )
+ dup (start-alarm) ;
projects / factor.git / commitdiff