Simplify the alarms implementation a bit
parent
39013d1373
commit
f3c9eab1f5
|
@ -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 ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue