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