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

Timers are now in seconds, not milliseconds

This commit is contained in:
Tony Garnock-Jones 2023-02-06 15:41:14 +01:00
parent 08e3290ff0
commit fe2b018c50
3 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
syndicate-examples/timer-demo.rkt
View File

@ -8,7 +8,7 @@
(standard-actor-system (ds)
(at ds
(log-info "waiting...")
(on (timeout 1000)
(on (timeout 1)
(log-info "still waiting..."))
(stop-on (timeout 2000)
(stop-on (timeout 2)
(log-info "done!")))))

24
syndicate/drivers/timer.rkt
View File

@ -42,7 +42,7 @@
(heap-remove-min! heap)
(hash-remove! timers label)
(log-syndicate/drivers/timer-debug "expired timer ~a" label)
(turn! facet (lambda () (send! ds (TimerExpired label now))))
(turn! facet (lambda () (send! ds (TimerExpired label (/ now 1000.0)))))
(set! count-fired (+ count-fired 1))
(loop)))))
(adjust-inhabitant-count! engine (- count-fired)))
@ -75,12 +75,12 @@
[(SetTimer label _ (TimerKind-clear))
(clear-timer! label)
(loop)]
[(SetTimer label msecs (TimerKind-relative))
(define deadline (+ (current-inexact-milliseconds) msecs))
[(SetTimer label secs (TimerKind-relative))
(define deadline (+ (current-inexact-milliseconds) (* 1000.0 secs)))
(install-timer! label deadline)
(loop)]
[(SetTimer label deadline (TimerKind-absolute))
(install-timer! label deadline)
(install-timer! label (* deadline 1000.0))
(loop)])))))))
(at ds
@ -88,19 +88,19 @@
(log-syndicate/drivers/timer-debug "received instruction ~a" instruction)
(channel-put control-ch instruction))
(during (Observe (:pattern (LaterThan ,(DLit $msecs))) _)
(during (Observe (:pattern (LaterThan ,(DLit $seconds))) _)
(log-syndicate/drivers/timer-debug "observing (later-than ~a) at ~a"
msecs
(current-inexact-milliseconds))
seconds
(/ (current-inexact-milliseconds) 1000.0))
(define timer-id (gensym 'timestate))
(on-start (send! (SetTimer timer-id msecs (TimerKind-absolute))))
(on-stop (send! (SetTimer timer-id msecs (TimerKind-clear))))
(on-start (send! (SetTimer timer-id seconds (TimerKind-absolute))))
(on-stop (send! (SetTimer timer-id seconds (TimerKind-clear))))
(on (message (TimerExpired timer-id _))
(react (assert (LaterThan msecs)))))))
(react (assert (LaterThan seconds)))))))
(define-event-expander timeout
(syntax-rules ()
[(_ [relative-msecs] body ...)
[(_ [relative-seconds] body ...)
(let ((timer-id (gensym 'timeout)))
(on-start (send! (SetTimer timer-id relative-msecs (TimerKind-relative))))
(on-start (send! (SetTimer timer-id relative-seconds (TimerKind-relative))))
(on (message (TimerExpired timer-id _)) body ...))]))

2
syndicate/test/core/during-with-spawn.rkt
View File

@ -8,7 +8,7 @@
(standard-actor-system (ds)
(spawn (at ds
(assert 'item)
(on (timeout 50) (stop-current-facet))))
(on (timeout 0.05) (stop-current-facet))))
(spawn #:daemon? #t
(at ds
(during/spawn 'item