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

Simplify the alarms implementation a bit

db4
Doug Coleman 2010-05-21 13:19:15 -05:00
parent 39013d1373
commit f3c9eab1f5
1 changed files with 10 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
basis/alarms/alarms.factor
View File

@ -9,8 +9,7 @@ TUPLE: alarm
{ quot callable initial: [ ] } { quot callable initial: [ ] }
{ start integer } { start integer }
interval interval
{ previous-iteration-begin integer } { iteration-scheduled integer }
{ iteration-begin integer }
{ stop? boolean } ; { stop? boolean } ;
SYMBOL: alarms SYMBOL: alarms
@ -31,8 +30,9 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
: <alarm> ( quot start interval -- alarm ) : <alarm> ( quot start interval -- alarm )
alarm new alarm new
swap >nanoseconds >>interval swap >nanoseconds >>interval
swap >nanoseconds nano-count + >>start swap >nanoseconds nano-count +
swap >>quot ; [ >>start ] [ >>iteration-scheduled ] bi
swap >>quot ; inline
: register-alarm ( alarm -- ) : register-alarm ( alarm -- )
dup start>> alarms get-global heap-push* drop dup start>> alarms get-global heap-push* drop
@ -41,21 +41,22 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
: alarm-expired? ( alarm n -- ? ) : alarm-expired? ( alarm n -- ? )
[ start>> ] dip <= ; [ start>> ] dip <= ;
: next-alarm-time ( alarm -- n ) : set-next-alarm-time ( alarm -- alarm )
! start + ceiling((now - start) / interval) * interval ! start + ceiling((now - start) / interval) * interval
nano-count nano-count
over start>> - over start>> -
over interval>> / ceiling over interval>> / ceiling
over interval>> * over interval>> *
swap start>> + ; inline over start>> + >>iteration-scheduled ; inline
DEFER: call-alarm-loop DEFER: call-alarm-loop
: loop-alarm ( alarm -- ) : loop-alarm ( alarm -- )
nano-count over nano-count over
[ iteration-begin>> - ] [ interval>> ] bi < [ [ iteration-scheduled>> - ] [ interval>> ] bi <
[ next-alarm-time sleep-until ] keep [ set-next-alarm-time ] dip [
call-alarm-loop [ iteration-scheduled>> sleep-until ]
[ call-alarm-loop ] bi
] [ ] [
0 sleep-until call-alarm-loop 0 sleep-until call-alarm-loop
] if ; ] if ;
@ -69,8 +70,6 @@ DEFER: call-alarm-loop
drop drop
] [ ] [
[ [
dup iteration-begin>> >>previous-iteration-begin
nano-count >>iteration-begin
[ ] [ quot>> ] bi call( obj -- ) [ ] [ quot>> ] bi call( obj -- )
] keep maybe-loop-alarm ] keep maybe-loop-alarm
] if ; ] if ;
@ -117,19 +116,6 @@ DEFER: call-alarm-loop
PRIVATE> 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 ) : add-alarm ( quot start interval -- alarm )
<alarm> [ register-alarm ] keep ; <alarm> [ register-alarm ] keep ;