syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Switch to symbolic specification of relative timeouts

This commit is contained in:
Tony Garnock-Jones 2012-02-19 17:09:23 -05:00
parent 481db45230
commit af941dc8d1
1 changed files with 31 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
os-timer.rkt
View File

@ -14,11 +14,11 @@
timer-driver
timer-relay)
;; (set-timer Any Number Boolean)
;; (set-timer Any Number (or 'relative 'absolute))
;; The timer driver and timer relays listen for messages of this type,
;; and when they hear one, they set an alarm that will later send a
;; corresponding timer-expired message.
(struct set-timer (label msecs relative?) #:prefab)
(struct set-timer (label msecs kind) #:prefab)
;; (timer-expired Any Number)
;; Message sent by the timer driver or a timer relay upon expiry of a
@ -80,24 +80,33 @@
(os-big-bang (make-timer-heap)
(subscribe 'timer-setter
(message-handlers heap
[(set-timer label msecs relative?)
(define deadline (if relative? (+ (current-inexact-milliseconds) msecs) msecs))
(define new-timer (pending-timer deadline label))
(heap-add! heap new-timer)
(let loop ((heap heap))
(define next (next-timer! heap))
(transition heap
(unsubscribe 'time-listener)
(if next
(subscribe 'time-listener
(ground-message-handler heap
[((list self-id 'time-listener)
(timer-evt (pending-timer-deadline next))
=> now)
(define to-send (fire-timers! heap now))
;; Note: compute to-send before calling loop, because of side-effects on heap
(extend-transition (loop heap) (map send-message to-send))]))
'())))]))))
[(set-timer label msecs 'relative)
(install-timer! self-id heap label (+ (current-inexact-milliseconds) msecs))]
[(set-timer label msecs 'absolute)
(install-timer! self-id heap label msecs)]))))
;; Symbol Heap<PendingTimer> Any AbsoluteSeconds -> Transition
(define (install-timer! self-id heap label deadline)
(define new-timer (pending-timer deadline label))
(heap-add! heap new-timer)
(update-time-listener! self-id heap))
;; Symbol Heap<PendingTimer> -> Transition
(define (update-time-listener! self-id heap)
(define next (next-timer! heap))
(transition heap
(unsubscribe 'time-listener)
(if next
(subscribe 'time-listener
(ground-message-handler heap
[((list self-id 'time-listener)
(timer-evt (pending-timer-deadline next))
=> now)
(define to-send (fire-timers! heap now))
;; Note: compute to-send before recursing, because of side-effects on heap
(extend-transition (update-time-listener! self-id heap)
(map send-message to-send))]))
'())))
;; [Symbol] -> BootK
;; Process for mapping this-level timer requests to meta-level timer
@ -115,7 +124,7 @@
active-timers)]))
(subscribe 'timer-relay-down
(message-handlers (relay-state next-counter active-timers)
[(set-timer label msecs relative?)
[(set-timer label msecs kind)
(transition (relay-state (+ next-counter 1)
(hash-set active-timers next-counter label))
(send-meta-message (set-timer (list self-id next-counter) msecs relative?)))]))))
(send-meta-message (set-timer (list self-id next-counter) msecs kind)))]))))