erlang: erlang:send_after/3 + cancel_timer/1 + monotonic_time (T1+T2, 766/766)
Logical-clock timer wheel in the scheduler. send_after schedules a message-delivery event at an absolute deadline (clock + Time ms); cancel_timer marks a live timer cancelled and reports remaining ms, or false. Time advances only when the runnable queue drains, jumping to the earliest pending deadline (deterministic, no wall clock). monotonic_time/0,1 exposes the logical ms clock. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -38,6 +38,7 @@ SUITES=(
|
|||||||
"fib|er-fib-test-pass|er-fib-test-count"
|
"fib|er-fib-test-pass|er-fib-test-count"
|
||||||
"ffi|er-ffi-test-pass|er-ffi-test-count"
|
"ffi|er-ffi-test-pass|er-ffi-test-count"
|
||||||
"vm|er-vm-test-pass|er-vm-test-count"
|
"vm|er-vm-test-pass|er-vm-test-count"
|
||||||
|
"send_after|er-sa-test-pass|er-sa-test-count"
|
||||||
)
|
)
|
||||||
|
|
||||||
cat > "$TMPFILE" << 'EPOCHS'
|
cat > "$TMPFILE" << 'EPOCHS'
|
||||||
@@ -61,6 +62,7 @@ cat > "$TMPFILE" << 'EPOCHS'
|
|||||||
(load "lib/erlang/vm/dispatcher.sx")
|
(load "lib/erlang/vm/dispatcher.sx")
|
||||||
(load "lib/erlang/tests/ffi.sx")
|
(load "lib/erlang/tests/ffi.sx")
|
||||||
(load "lib/erlang/tests/vm.sx")
|
(load "lib/erlang/tests/vm.sx")
|
||||||
|
(load "lib/erlang/tests/send_after.sx")
|
||||||
(epoch 100)
|
(epoch 100)
|
||||||
(eval "(list er-test-pass er-test-count)")
|
(eval "(list er-test-pass er-test-count)")
|
||||||
(epoch 101)
|
(epoch 101)
|
||||||
@@ -83,6 +85,8 @@ cat > "$TMPFILE" << 'EPOCHS'
|
|||||||
(eval "(list er-ffi-test-pass er-ffi-test-count)")
|
(eval "(list er-ffi-test-pass er-ffi-test-count)")
|
||||||
(epoch 110)
|
(epoch 110)
|
||||||
(eval "(list er-vm-test-pass er-vm-test-count)")
|
(eval "(list er-vm-test-pass er-vm-test-count)")
|
||||||
|
(epoch 111)
|
||||||
|
(eval "(list er-sa-test-pass er-sa-test-count)")
|
||||||
EPOCHS
|
EPOCHS
|
||||||
|
|
||||||
timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
|
timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
|
||||||
|
|||||||
@@ -135,6 +135,56 @@
|
|||||||
(dict-set! s :next-ref (+ n 1))
|
(dict-set! s :next-ref (+ n 1))
|
||||||
(er-mk-ref n)))))
|
(er-mk-ref n)))))
|
||||||
|
|
||||||
|
;; ── logical clock + timer wheel ──────────────────────────────────
|
||||||
|
;; The scheduler runs a synchronous model: logical time advances only
|
||||||
|
;; when the runnable queue drains (see `er-sched-advance-time!`). The
|
||||||
|
;; clock is in milliseconds, monotonic, never derived from wall time
|
||||||
|
;; — deterministic and time-travel-safe. `send_after` schedules a
|
||||||
|
;; message-delivery event at an absolute deadline; `receive after Ms`
|
||||||
|
;; schedules a timeout event the same way. When no process is runnable
|
||||||
|
;; the scheduler jumps the clock to the earliest pending deadline and
|
||||||
|
;; fires that single event, then re-runs.
|
||||||
|
(define er-clock (fn () (get (er-sched) :clock)))
|
||||||
|
|
||||||
|
;; Advance the clock to `ms`, but never backwards (monotonicity).
|
||||||
|
(define
|
||||||
|
er-clock-set!
|
||||||
|
(fn (ms) (dict-set! (er-sched) :clock (max (er-clock) ms))))
|
||||||
|
|
||||||
|
(define er-sched-timers (fn () (get (er-sched) :timers)))
|
||||||
|
|
||||||
|
;; Register a timer event. `dest` is a pid or registered-atom value,
|
||||||
|
;; resolved to a live process at fire time. Returns the timer ref.
|
||||||
|
(define
|
||||||
|
er-timer-add!
|
||||||
|
(fn
|
||||||
|
(deadline dest msg ref)
|
||||||
|
(append!
|
||||||
|
(er-sched-timers)
|
||||||
|
{:ref ref :deadline deadline :dest dest :msg msg :alive true})
|
||||||
|
ref))
|
||||||
|
|
||||||
|
;; Find the live timer with the given ref, or nil.
|
||||||
|
(define
|
||||||
|
er-timer-find-alive
|
||||||
|
(fn
|
||||||
|
(ref)
|
||||||
|
(let
|
||||||
|
((ts (er-sched-timers)) (found (list nil)))
|
||||||
|
(for-each
|
||||||
|
(fn
|
||||||
|
(i)
|
||||||
|
(let
|
||||||
|
((t (nth ts i)))
|
||||||
|
(when
|
||||||
|
(and
|
||||||
|
(= (nth found 0) nil)
|
||||||
|
(get t :alive)
|
||||||
|
(er-ref-equal? (get t :ref) ref))
|
||||||
|
(set-nth! found 0 t))))
|
||||||
|
(range 0 (len ts)))
|
||||||
|
(nth found 0))))
|
||||||
|
|
||||||
;; ── scheduler state ──────────────────────────────────────────────
|
;; ── scheduler state ──────────────────────────────────────────────
|
||||||
(define er-scheduler (list nil))
|
(define er-scheduler (list nil))
|
||||||
|
|
||||||
@@ -151,6 +201,8 @@
|
|||||||
:processes {}
|
:processes {}
|
||||||
:registered {}
|
:registered {}
|
||||||
:ets {}
|
:ets {}
|
||||||
|
:clock 0
|
||||||
|
:timers (list)
|
||||||
:runnable (er-q-new)})))
|
:runnable (er-q-new)})))
|
||||||
|
|
||||||
(define er-sched (fn () (nth er-scheduler 0)))
|
(define er-sched (fn () (nth er-scheduler 0)))
|
||||||
@@ -217,6 +269,7 @@
|
|||||||
:trap-exit false
|
:trap-exit false
|
||||||
:has-timeout false
|
:has-timeout false
|
||||||
:timed-out false
|
:timed-out false
|
||||||
|
:timeout-deadline nil
|
||||||
:exit-reason nil}))
|
:exit-reason nil}))
|
||||||
(dict-set! (er-sched-processes) (er-pid-key pid) proc)
|
(dict-set! (er-sched-processes) (er-pid-key pid) proc)
|
||||||
(er-sched-enqueue! pid)
|
(er-sched-enqueue! pid)
|
||||||
@@ -456,6 +509,69 @@
|
|||||||
(error "Erlang: make_ref/0: arity")
|
(error "Erlang: make_ref/0: arity")
|
||||||
(er-ref-new!))))
|
(er-ref-new!))))
|
||||||
|
|
||||||
|
;; ── timer BIFs ───────────────────────────────────────────────────
|
||||||
|
;; erlang:send_after(Time, Dest, Msg) -> Ref
|
||||||
|
;; Schedules Msg to be delivered to Dest after Time ms (logical).
|
||||||
|
;; Time must be a non-negative integer; Dest a pid or registered
|
||||||
|
;; atom name. Returns a fresh timer reference.
|
||||||
|
(define
|
||||||
|
er-bif-send-after
|
||||||
|
(fn
|
||||||
|
(vs)
|
||||||
|
(let
|
||||||
|
((time (nth vs 0)) (dest (nth vs 1)) (msg (nth vs 2)))
|
||||||
|
(cond
|
||||||
|
(not (and (= (type-of time) "number") (>= time 0)))
|
||||||
|
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||||
|
(not (or (er-pid? dest) (er-atom? dest)))
|
||||||
|
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||||
|
:else
|
||||||
|
(er-timer-add!
|
||||||
|
(+ (er-clock) (truncate time))
|
||||||
|
dest
|
||||||
|
msg
|
||||||
|
(er-ref-new!))))))
|
||||||
|
|
||||||
|
;; erlang:cancel_timer(Ref) -> RemainingMs | false
|
||||||
|
;; For a live (not-yet-fired) timer, marks it cancelled and returns
|
||||||
|
;; the milliseconds left until its deadline. For an already-fired,
|
||||||
|
;; already-cancelled, or unknown ref, returns the atom `false`.
|
||||||
|
(define
|
||||||
|
er-bif-cancel-timer
|
||||||
|
(fn
|
||||||
|
(vs)
|
||||||
|
(let
|
||||||
|
((ref (nth vs 0)))
|
||||||
|
(cond
|
||||||
|
(not (er-ref? ref))
|
||||||
|
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||||
|
:else
|
||||||
|
(let
|
||||||
|
((t (er-timer-find-alive ref)))
|
||||||
|
(cond
|
||||||
|
(= t nil) (er-mk-atom "false")
|
||||||
|
:else (do
|
||||||
|
(dict-set! t :alive false)
|
||||||
|
(max 0 (- (get t :deadline) (er-clock))))))))))
|
||||||
|
|
||||||
|
;; erlang:monotonic_time() | erlang:monotonic_time(Unit) -> Integer
|
||||||
|
;; Returns the scheduler's logical monotonic clock in milliseconds.
|
||||||
|
;; Unit (millisecond / second / native) is accepted for API
|
||||||
|
;; compatibility; all units report from the same ms-resolution clock.
|
||||||
|
(define
|
||||||
|
er-bif-monotonic-time
|
||||||
|
(fn
|
||||||
|
(vs)
|
||||||
|
(cond
|
||||||
|
(= (len vs) 0) (er-clock)
|
||||||
|
(and (= (len vs) 1) (er-atom? (nth vs 0)))
|
||||||
|
(let
|
||||||
|
((unit (get (nth vs 0) :name)))
|
||||||
|
(cond
|
||||||
|
(= unit "second") (truncate (/ (er-clock) 1000))
|
||||||
|
:else (er-clock)))
|
||||||
|
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
|
||||||
|
|
||||||
;; Add `target` to `pid`'s :links list if not already there.
|
;; Add `target` to `pid`'s :links list if not already there.
|
||||||
(define
|
(define
|
||||||
er-link-add-one!
|
er-link-add-one!
|
||||||
@@ -664,37 +780,122 @@
|
|||||||
(cond
|
(cond
|
||||||
(not (= pid nil))
|
(not (= pid nil))
|
||||||
(do (er-sched-step! pid) (er-sched-run-all!))
|
(do (er-sched-step! pid) (er-sched-run-all!))
|
||||||
;; Queue empty — fire one pending receive-with-timeout and go again.
|
;; Queue empty — advance logical time to the next pending
|
||||||
(er-sched-fire-one-timeout!) (er-sched-run-all!)
|
;; deadline (timer delivery or receive-timeout) and go again.
|
||||||
|
(er-sched-advance-time!) (er-sched-run-all!)
|
||||||
:else nil))))
|
:else nil))))
|
||||||
|
|
||||||
;; Wake one waiting process whose receive had an `after Ms` clause.
|
;; ── time advance ─────────────────────────────────────────────────
|
||||||
;; Returns true if one fired. In our synchronous model "time passes"
|
;; Called when the runnable queue is empty. Two kinds of pending event
|
||||||
;; once the runnable queue drains — timeouts only fire then.
|
;; carry a deadline: live `send_after` timers and waiting processes in
|
||||||
|
;; a `receive ... after Ms` block. Find the single earliest deadline
|
||||||
|
;; across both, jump the clock to it, and fire just that one event
|
||||||
|
;; (timer wins ties — a message delivered exactly at the timeout
|
||||||
|
;; arrives "first"). Returns true if an event fired, false when there
|
||||||
|
;; is nothing left to wake (genuine idle / termination).
|
||||||
(define
|
(define
|
||||||
er-sched-fire-one-timeout!
|
er-sched-advance-time!
|
||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
((ks (keys (er-sched-processes))) (fired (list false)))
|
((best (er-sched-next-event)))
|
||||||
|
(cond
|
||||||
|
(= best nil) false
|
||||||
|
:else (do
|
||||||
|
(er-clock-set! (get best :deadline))
|
||||||
|
(cond
|
||||||
|
(= (get best :kind) "timer")
|
||||||
|
(er-timer-fire! (get best :timer))
|
||||||
|
:else (er-recv-timeout-fire! (get best :proc)))
|
||||||
|
true)))))
|
||||||
|
|
||||||
|
;; Scan timers and waiting-with-timeout processes for the earliest
|
||||||
|
;; deadline. Returns {:kind "timer"|"recv" :deadline D ...} or nil.
|
||||||
|
(define
|
||||||
|
er-sched-next-event
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(let
|
||||||
|
((best (list nil)))
|
||||||
|
(for-each
|
||||||
|
(fn
|
||||||
|
(i)
|
||||||
|
(let
|
||||||
|
((t (nth (er-sched-timers) i)))
|
||||||
|
(when
|
||||||
|
(get t :alive)
|
||||||
|
(er-event-consider!
|
||||||
|
best
|
||||||
|
{:kind "timer" :deadline (get t :deadline) :timer t}))))
|
||||||
|
(range 0 (len (er-sched-timers))))
|
||||||
(for-each
|
(for-each
|
||||||
(fn
|
(fn
|
||||||
(k)
|
(k)
|
||||||
(when
|
(let
|
||||||
(not (nth fired 0))
|
((p (get (er-sched-processes) k)))
|
||||||
(let
|
(when
|
||||||
((p (get (er-sched-processes) k)))
|
(and (= (get p :state) "waiting") (get p :has-timeout))
|
||||||
(when
|
(er-event-consider!
|
||||||
(and
|
best
|
||||||
(= (get p :state) "waiting")
|
{:kind "recv"
|
||||||
(get p :has-timeout))
|
:deadline (get p :timeout-deadline)
|
||||||
(dict-set! p :timed-out true)
|
:proc p}))))
|
||||||
(dict-set! p :has-timeout false)
|
(keys (er-sched-processes)))
|
||||||
(dict-set! p :state "runnable")
|
(nth best 0))))
|
||||||
(er-sched-enqueue! (get p :pid))
|
|
||||||
(set-nth! fired 0 true)))))
|
;; Keep the earlier-deadline candidate in the single-cell `best`.
|
||||||
ks)
|
;; Strictly-earlier replaces; equal deadlines keep the incumbent so a
|
||||||
(nth fired 0))))
|
;; timer registered first (and timers over recv-timeouts) win ties.
|
||||||
|
(define
|
||||||
|
er-event-consider!
|
||||||
|
(fn
|
||||||
|
(best cand)
|
||||||
|
(when
|
||||||
|
(or
|
||||||
|
(= (nth best 0) nil)
|
||||||
|
(< (get cand :deadline) (get (nth best 0) :deadline)))
|
||||||
|
(set-nth! best 0 cand))))
|
||||||
|
|
||||||
|
;; Deliver a fired timer's message to its destination and retire it.
|
||||||
|
;; Destination is resolved at fire time; a dead/missing target (or an
|
||||||
|
;; unregistered name) silently drops the message, as in real Erlang.
|
||||||
|
(define
|
||||||
|
er-timer-fire!
|
||||||
|
(fn
|
||||||
|
(t)
|
||||||
|
(dict-set! t :alive false)
|
||||||
|
(let
|
||||||
|
((pid (er-timer-resolve-dest (get t :dest))))
|
||||||
|
(when
|
||||||
|
(and (not (= pid nil)) (er-proc-exists? pid))
|
||||||
|
(er-proc-mailbox-push! pid (get t :msg))
|
||||||
|
(when
|
||||||
|
(= (er-proc-field pid :state) "waiting")
|
||||||
|
(er-proc-set! pid :state "runnable")
|
||||||
|
(er-sched-enqueue! pid))))))
|
||||||
|
|
||||||
|
;; Non-raising destination resolver for timer delivery.
|
||||||
|
(define
|
||||||
|
er-timer-resolve-dest
|
||||||
|
(fn
|
||||||
|
(v)
|
||||||
|
(cond
|
||||||
|
(er-pid? v) v
|
||||||
|
(er-atom? v)
|
||||||
|
(let
|
||||||
|
((name (get v :name)))
|
||||||
|
(if (dict-has? (er-registered) name) (get (er-registered) name) nil))
|
||||||
|
:else nil)))
|
||||||
|
|
||||||
|
;; Wake a process whose `receive ... after Ms` deadline elapsed.
|
||||||
|
(define
|
||||||
|
er-recv-timeout-fire!
|
||||||
|
(fn
|
||||||
|
(p)
|
||||||
|
(dict-set! p :timed-out true)
|
||||||
|
(dict-set! p :has-timeout false)
|
||||||
|
(dict-set! p :state "runnable")
|
||||||
|
(er-sched-enqueue! (get p :pid))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
er-sched-step!
|
er-sched-step!
|
||||||
@@ -1785,6 +1986,10 @@
|
|||||||
(er-register-bif! "erlang" "exit" 1 er-bif-exit)
|
(er-register-bif! "erlang" "exit" 1 er-bif-exit)
|
||||||
(er-register-bif! "erlang" "exit" 2 er-bif-exit)
|
(er-register-bif! "erlang" "exit" 2 er-bif-exit)
|
||||||
(er-register-bif! "erlang" "make_ref" 0 er-bif-make-ref)
|
(er-register-bif! "erlang" "make_ref" 0 er-bif-make-ref)
|
||||||
|
(er-register-bif! "erlang" "send_after" 3 er-bif-send-after)
|
||||||
|
(er-register-bif! "erlang" "cancel_timer" 1 er-bif-cancel-timer)
|
||||||
|
(er-register-bif! "erlang" "monotonic_time" 0 er-bif-monotonic-time)
|
||||||
|
(er-register-bif! "erlang" "monotonic_time" 1 er-bif-monotonic-time)
|
||||||
(er-register-bif! "erlang" "link" 1 er-bif-link)
|
(er-register-bif! "erlang" "link" 1 er-bif-link)
|
||||||
(er-register-bif! "erlang" "unlink" 1 er-bif-unlink)
|
(er-register-bif! "erlang" "unlink" 1 er-bif-unlink)
|
||||||
(er-register-bif! "erlang" "monitor" 2 er-bif-monitor)
|
(er-register-bif! "erlang" "monitor" 2 er-bif-monitor)
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{
|
{
|
||||||
"language": "erlang",
|
"language": "erlang",
|
||||||
"total_pass": 761,
|
"total_pass": 766,
|
||||||
"total": 761,
|
"total": 766,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
|
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
|
||||||
{"name":"parse","pass":52,"total":52,"status":"ok"},
|
{"name":"parse","pass":52,"total":52,"status":"ok"},
|
||||||
@@ -13,6 +13,7 @@
|
|||||||
{"name":"echo","pass":7,"total":7,"status":"ok"},
|
{"name":"echo","pass":7,"total":7,"status":"ok"},
|
||||||
{"name":"fib","pass":8,"total":8,"status":"ok"},
|
{"name":"fib","pass":8,"total":8,"status":"ok"},
|
||||||
{"name":"ffi","pass":37,"total":37,"status":"ok"},
|
{"name":"ffi","pass":37,"total":37,"status":"ok"},
|
||||||
{"name":"vm","pass":78,"total":78,"status":"ok"}
|
{"name":"vm","pass":78,"total":78,"status":"ok"},
|
||||||
|
{"name":"send_after","pass":5,"total":5,"status":"ok"}
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
# Erlang-on-SX Scoreboard
|
# Erlang-on-SX Scoreboard
|
||||||
|
|
||||||
**Total: 761 / 761 tests passing**
|
**Total: 766 / 766 tests passing**
|
||||||
|
|
||||||
| | Suite | Pass | Total |
|
| | Suite | Pass | Total |
|
||||||
|---|---|---|---|
|
|---|---|---|---|
|
||||||
@@ -15,6 +15,7 @@
|
|||||||
| ✅ | fib | 8 | 8 |
|
| ✅ | fib | 8 | 8 |
|
||||||
| ✅ | ffi | 37 | 37 |
|
| ✅ | ffi | 37 | 37 |
|
||||||
| ✅ | vm | 78 | 78 |
|
| ✅ | vm | 78 | 78 |
|
||||||
|
| ✅ | send_after | 5 | 5 |
|
||||||
|
|
||||||
|
|
||||||
Generated by `lib/erlang/conformance.sh`.
|
Generated by `lib/erlang/conformance.sh`.
|
||||||
|
|||||||
80
lib/erlang/tests/send_after.sx
Normal file
80
lib/erlang/tests/send_after.sx
Normal file
@@ -0,0 +1,80 @@
|
|||||||
|
;; erlang:send_after / cancel_timer — timer primitives.
|
||||||
|
;;
|
||||||
|
;; A process schedules a message to itself (or another pid / registered
|
||||||
|
;; name) after N logical milliseconds. `cancel_timer` removes a pending
|
||||||
|
;; timer and reports the time left. These are the same primitives the
|
||||||
|
;; gen_server library uses to implement `{noreply, State, Timeout}`.
|
||||||
|
;;
|
||||||
|
;; The scheduler runs a synchronous logical clock (see runtime.sx
|
||||||
|
;; `er-sched-advance-time!`): time advances only when the runnable
|
||||||
|
;; queue drains, jumping to the earliest pending deadline. That makes
|
||||||
|
;; delivery deterministic and time-travel-safe — no wall clock.
|
||||||
|
|
||||||
|
(define er-sa-test-count 0)
|
||||||
|
(define er-sa-test-pass 0)
|
||||||
|
(define er-sa-test-fails (list))
|
||||||
|
|
||||||
|
(define
|
||||||
|
er-sa-test
|
||||||
|
(fn
|
||||||
|
(name actual expected)
|
||||||
|
(set! er-sa-test-count (+ er-sa-test-count 1))
|
||||||
|
(if
|
||||||
|
(= actual expected)
|
||||||
|
(set! er-sa-test-pass (+ er-sa-test-pass 1))
|
||||||
|
(append!
|
||||||
|
er-sa-test-fails
|
||||||
|
{:actual actual :expected expected :name name}))))
|
||||||
|
|
||||||
|
(define er-sa-pred
|
||||||
|
(fn (name actual) (er-sa-test name (if actual true false) true)))
|
||||||
|
|
||||||
|
(define sa-ev erlang-eval-ast)
|
||||||
|
|
||||||
|
;; ── T1 — schedule a self-message, receive it after the deadline ──
|
||||||
|
;; send_after returns a reference handle.
|
||||||
|
(er-sa-pred
|
||||||
|
"T1 send_after returns a ref"
|
||||||
|
(er-ref?
|
||||||
|
(sa-ev "erlang:send_after(50, self(), hello)")))
|
||||||
|
|
||||||
|
;; The scheduled message lands and a plain receive picks it up.
|
||||||
|
(er-sa-test
|
||||||
|
"T1 delivered message received"
|
||||||
|
(get
|
||||||
|
(sa-ev
|
||||||
|
"erlang:send_after(50, self(), hello),
|
||||||
|
receive M -> M end")
|
||||||
|
:name)
|
||||||
|
"hello")
|
||||||
|
|
||||||
|
;; Logical time advances exactly to the timer deadline (50ms) by the
|
||||||
|
;; time the message is received — round-trip latency well under 100ms.
|
||||||
|
(er-sa-test
|
||||||
|
"T1 clock at deadline on receipt"
|
||||||
|
(sa-ev
|
||||||
|
"erlang:send_after(50, self(), hello),
|
||||||
|
receive hello -> erlang:monotonic_time() end")
|
||||||
|
50)
|
||||||
|
|
||||||
|
;; ── T2 — cancel_timer returns remaining ms; message never arrives ──
|
||||||
|
;; Cancel immediately after scheduling: clock has not advanced, so the
|
||||||
|
;; full duration (~1000ms) is reported as remaining.
|
||||||
|
(er-sa-test
|
||||||
|
"T2 cancel returns remaining ms"
|
||||||
|
(sa-ev
|
||||||
|
"Ref = erlang:send_after(1000, self(), late),
|
||||||
|
erlang:cancel_timer(Ref)")
|
||||||
|
1000)
|
||||||
|
|
||||||
|
;; The cancelled timer never delivers — the receive falls through to
|
||||||
|
;; its `after` clause and returns `none`.
|
||||||
|
(er-sa-test
|
||||||
|
"T2 cancelled message never arrives"
|
||||||
|
(get
|
||||||
|
(sa-ev
|
||||||
|
"Ref = erlang:send_after(1000, self(), late),
|
||||||
|
erlang:cancel_timer(Ref),
|
||||||
|
receive late -> got after 50 -> none end")
|
||||||
|
:name)
|
||||||
|
"none")
|
||||||
@@ -1147,7 +1147,7 @@
|
|||||||
(and (er-atom? ms) (= (get ms :name) "infinity"))
|
(and (er-atom? ms) (= (get ms :name) "infinity"))
|
||||||
(er-eval-receive-loop node pid env)
|
(er-eval-receive-loop node pid env)
|
||||||
(= ms 0) (er-eval-receive-poll node pid env)
|
(= ms 0) (er-eval-receive-poll node pid env)
|
||||||
:else (er-eval-receive-timed node pid env)))))
|
:else (er-eval-receive-timed node pid env (+ (er-clock) ms))))))
|
||||||
|
|
||||||
;; after 0 — poll once; on no match, run the after-body immediately.
|
;; after 0 — poll once; on no match, run the after-body immediately.
|
||||||
(define
|
(define
|
||||||
@@ -1161,12 +1161,15 @@
|
|||||||
(get r :value)
|
(get r :value)
|
||||||
(er-eval-body (get node :after-body) env)))))
|
(er-eval-body (get node :after-body) env)))))
|
||||||
|
|
||||||
;; after Ms — suspend; on resume check :timed-out. When the scheduler
|
;; after Ms — suspend with an absolute `deadline` (logical ms). On
|
||||||
;; runs out of other work it fires one pending timeout per round.
|
;; resume check :timed-out: the scheduler fires the earliest pending
|
||||||
|
;; deadline once the runnable queue drains. A non-matching message can
|
||||||
|
;; wake the process early; it re-suspends on the SAME deadline so the
|
||||||
|
;; timeout window is not extended.
|
||||||
(define
|
(define
|
||||||
er-eval-receive-timed
|
er-eval-receive-timed
|
||||||
(fn
|
(fn
|
||||||
(node pid env)
|
(node pid env deadline)
|
||||||
(let
|
(let
|
||||||
((r (er-try-receive (get node :clauses) pid env)))
|
((r (er-try-receive (get node :clauses) pid env)))
|
||||||
(if
|
(if
|
||||||
@@ -1174,6 +1177,7 @@
|
|||||||
(get r :value)
|
(get r :value)
|
||||||
(do
|
(do
|
||||||
(er-proc-set! pid :has-timeout true)
|
(er-proc-set! pid :has-timeout true)
|
||||||
|
(er-proc-set! pid :timeout-deadline deadline)
|
||||||
(call/cc
|
(call/cc
|
||||||
(fn
|
(fn
|
||||||
(k)
|
(k)
|
||||||
@@ -1186,7 +1190,7 @@
|
|||||||
(er-proc-set! pid :timed-out false)
|
(er-proc-set! pid :timed-out false)
|
||||||
(er-proc-set! pid :has-timeout false)
|
(er-proc-set! pid :has-timeout false)
|
||||||
(er-eval-body (get node :after-body) env))
|
(er-eval-body (get node :after-body) env))
|
||||||
(er-eval-receive-timed node pid env)))))))
|
(er-eval-receive-timed node pid env deadline)))))))
|
||||||
|
|
||||||
;; Scan mailbox in arrival order. For each msg, try every clause.
|
;; Scan mailbox in arrival order. For each msg, try every clause.
|
||||||
;; On first match: remove that msg from mailbox and return body value.
|
;; On first match: remove that msg from mailbox and return body value.
|
||||||
|
|||||||
Reference in New Issue
Block a user