Remove typo slot, fix scheduling formula, record initial iteration nano-count
parent
c8af0e4d5c
commit
591a77700d
|
@ -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>
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue