     { quot callable initial: [ ] }
     { start integer }
     interval
-    { previous-iteration-begin integer }
-    { iteration-begin integer }
+    { iteration-scheduled integer }
     { stop? boolean } ;
 
 SYMBOL: alarms


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 )
    <alarm> [ register-alarm ] keep ;


: alarm-expired? ( alarm n -- ? )
    [ start>> ] dip <= ;

: set-next-alarm-time ( alarm -- alarm )
    ! start + ceiling((now - start) / interval) * interval
    nano-count 
    over start>> -
    over interval>> / ceiling
    over interval>> *
    over start>> + >>iteration-scheduled ; 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 ;
