syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Clear no-longer-interesting timers

This commit is contained in:
Tony Garnock-Jones 2018-08-14 12:33:50 +01:00
parent 979d057f3f
commit e9457af8c2
1 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
syndicate/drivers/timer.rkt
View File

@ -32,6 +32,8 @@
(make-heap (lambda (t1 t2) (<= (pending-timer-deadline t1)
(pending-timer-deadline t2)))))
(define timers (make-hash))
(define (next-timer)
(and (positive? (heap-count heap))
(heap-min heap)))
@ -42,16 +44,27 @@
(when (positive? (heap-count heap))
(let ((m (heap-min heap)))
(when (<= (pending-timer-deadline m) now)
(begin (heap-remove-min! heap)
(log-syndicate/drivers/timer-debug "expired timer ~a"
(pending-timer-label m))
(ground-send! (timer-expired (pending-timer-label m) now))
(set! count-fired (+ count-fired 1))
(loop))))))
(define label (pending-timer-label m))
(heap-remove-min! heap)
(hash-remove! timers label)
(log-syndicate/drivers/timer-debug "expired timer ~a" label)
(ground-send! (timer-expired label now))
(set! count-fired (+ count-fired 1))
(loop)))))
(signal-background-activity! (- count-fired)))
(define (clear-timer! label)
(match (hash-ref timers label #f)
[#f (void)]
[deadline
(heap-remove! heap (pending-timer deadline label))
(hash-remove! timers label)
(signal-background-activity! -1)]))
(define (install-timer! label deadline)
(clear-timer! label)
(heap-add! heap (pending-timer deadline label))
(hash-set! timers label deadline)
(signal-background-activity! +1))
(let loop ()
@ -64,6 +77,9 @@
(loop)))])
(handle-evt control-ch
(match-lambda
[(set-timer label _ 'clear)
(clear-timer! label)
(loop)]
[(set-timer label msecs 'relative)
(define deadline (+ (current-inexact-milliseconds) msecs))
(install-timer! label deadline)
@ -82,9 +98,7 @@
(current-inexact-milliseconds))
(define timer-id (gensym 'timestate))
(on-start (send! (set-timer timer-id msecs 'absolute)))
;; TODO: on-stop to delete irrelevant timers, so that their background-activity is
;; removed, so that programs don't stay running uselessly while previously-set but
;; now-unwanted timers expire unobserved.
(on-stop (send! (set-timer timer-id msecs 'clear)))
(on (message (timer-expired timer-id _))
(react (assert (later-than msecs))))))