Remove typo slot, fix scheduling formula, record initial iteration nano-count

db4
Doug Coleman 2010-05-23 18:44:04 -05:00
parent c8af0e4d5c
commit 591a77700d
1 changed files with 16 additions and 10 deletions

View File

@ -9,9 +9,10 @@ TUPLE: alarm
{ quot callable initial: [ ] } { quot callable initial: [ ] }
start-nanos start-nanos
delay-nanos delay-nanos
interval-nanos integer interval-nanos
{ next-iteration-nanos integer } iteration-start-nanos
{ stop? boolean } ; { stop? boolean }
thread ;
<PRIVATE <PRIVATE
@ -21,21 +22,23 @@ M: real >nanoseconds >integer ;
M: duration >nanoseconds duration>nanoseconds >integer ; M: duration >nanoseconds duration>nanoseconds >integer ;
: set-next-alarm-time ( alarm -- alarm ) : set-next-alarm-time ( alarm -- alarm )
! start + delay + ceiling((now - start) / interval) * interval ! start + delay + ceiling((now - (start + delay)) / interval) * interval
nano-count nano-count
over start-nanos>> - over start-nanos>> -
over delay-nanos>> [ + ] when* over delay-nanos>> [ - ] when*
over interval-nanos>> / ceiling over interval-nanos>> / ceiling
over interval-nanos>> * over interval-nanos>> *
over start-nanos>> + >>next-iteration-nanos ; inline over start-nanos>> +
over delay-nanos>> [ + ] when*
>>iteration-start-nanos ; inline
DEFER: call-alarm-loop DEFER: call-alarm-loop
: loop-alarm ( alarm -- ) : loop-alarm ( alarm -- )
nano-count over nano-count over
[ next-iteration-nanos>> - ] [ interval-nanos>> ] bi < [ iteration-start-nanos>> - ] [ interval-nanos>> ] bi <
[ set-next-alarm-time ] dip [ set-next-alarm-time ] dip
[ dup next-iteration-nanos>> ] [ 0 ] if [ dup iteration-start-nanos>> ] [ 0 ] if
sleep-until call-alarm-loop ; sleep-until call-alarm-loop ;
: maybe-loop-alarm ( alarm -- ) : maybe-loop-alarm ( alarm -- )
@ -51,8 +54,11 @@ DEFER: call-alarm-loop
] if ; ] if ;
: call-alarm ( alarm -- ) : call-alarm ( alarm -- )
[ delay-nanos>> ] [ ] bi '[
'[ _ [ sleep ] when* _ call-alarm-loop ] "Alarm execution" spawn drop ; _ self >>thread
[ delay-nanos>> [ sleep ] when* ]
[ nano-count >>iteration-start-nanos call-alarm-loop ] bi
] "Alarm execution" spawn drop ;
PRIVATE> PRIVATE>