diff --git a/lib/erlang/conformance.sh b/lib/erlang/conformance.sh index c4a56a0d..334b6d36 100755 --- a/lib/erlang/conformance.sh +++ b/lib/erlang/conformance.sh @@ -38,6 +38,7 @@ SUITES=( "fib|er-fib-test-pass|er-fib-test-count" "ffi|er-ffi-test-pass|er-ffi-test-count" "vm|er-vm-test-pass|er-vm-test-count" + "send_after|er-sa-test-pass|er-sa-test-count" ) cat > "$TMPFILE" << 'EPOCHS' @@ -61,6 +62,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/erlang/vm/dispatcher.sx") (load "lib/erlang/tests/ffi.sx") (load "lib/erlang/tests/vm.sx") +(load "lib/erlang/tests/send_after.sx") (epoch 100) (eval "(list er-test-pass er-test-count)") (epoch 101) @@ -83,6 +85,8 @@ cat > "$TMPFILE" << 'EPOCHS' (eval "(list er-ffi-test-pass er-ffi-test-count)") (epoch 110) (eval "(list er-vm-test-pass er-vm-test-count)") +(epoch 111) +(eval "(list er-sa-test-pass er-sa-test-count)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/erlang/runtime.sx b/lib/erlang/runtime.sx index f6db3733..6cd8be20 100644 --- a/lib/erlang/runtime.sx +++ b/lib/erlang/runtime.sx @@ -135,6 +135,56 @@ (dict-set! s :next-ref (+ n 1)) (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 ────────────────────────────────────────────── (define er-scheduler (list nil)) @@ -151,6 +201,8 @@ :processes {} :registered {} :ets {} + :clock 0 + :timers (list) :runnable (er-q-new)}))) (define er-sched (fn () (nth er-scheduler 0))) @@ -217,6 +269,7 @@ :trap-exit false :has-timeout false :timed-out false + :timeout-deadline nil :exit-reason nil})) (dict-set! (er-sched-processes) (er-pid-key pid) proc) (er-sched-enqueue! pid) @@ -456,6 +509,69 @@ (error "Erlang: make_ref/0: arity") (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. (define er-link-add-one! @@ -664,37 +780,122 @@ (cond (not (= pid nil)) (do (er-sched-step! pid) (er-sched-run-all!)) - ;; Queue empty — fire one pending receive-with-timeout and go again. - (er-sched-fire-one-timeout!) (er-sched-run-all!) + ;; Queue empty — advance logical time to the next pending + ;; deadline (timer delivery or receive-timeout) and go again. + (er-sched-advance-time!) (er-sched-run-all!) :else nil)))) -;; Wake one waiting process whose receive had an `after Ms` clause. -;; Returns true if one fired. In our synchronous model "time passes" -;; once the runnable queue drains — timeouts only fire then. +;; ── time advance ───────────────────────────────────────────────── +;; Called when the runnable queue is empty. Two kinds of pending event +;; 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 - er-sched-fire-one-timeout! + er-sched-advance-time! (fn () (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 (fn (k) - (when - (not (nth fired 0)) - (let - ((p (get (er-sched-processes) k))) - (when - (and - (= (get p :state) "waiting") - (get p :has-timeout)) - (dict-set! p :timed-out true) - (dict-set! p :has-timeout false) - (dict-set! p :state "runnable") - (er-sched-enqueue! (get p :pid)) - (set-nth! fired 0 true))))) - ks) - (nth fired 0)))) + (let + ((p (get (er-sched-processes) k))) + (when + (and (= (get p :state) "waiting") (get p :has-timeout)) + (er-event-consider! + best + {:kind "recv" + :deadline (get p :timeout-deadline) + :proc p})))) + (keys (er-sched-processes))) + (nth best 0)))) + +;; Keep the earlier-deadline candidate in the single-cell `best`. +;; Strictly-earlier replaces; equal deadlines keep the incumbent so a +;; 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 er-sched-step! @@ -1506,6 +1707,10 @@ (er-register-bif! "erlang" "exit" 1 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" "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" "unlink" 1 er-bif-unlink) (er-register-bif! "erlang" "monitor" 2 er-bif-monitor) diff --git a/lib/erlang/scoreboard.json b/lib/erlang/scoreboard.json index a86b5fc6..3f06c462 100644 --- a/lib/erlang/scoreboard.json +++ b/lib/erlang/scoreboard.json @@ -1,7 +1,7 @@ { "language": "erlang", - "total_pass": 761, - "total": 761, + "total_pass": 766, + "total": 766, "suites": [ {"name":"tokenize","pass":62,"total":62,"status":"ok"}, {"name":"parse","pass":52,"total":52,"status":"ok"}, @@ -13,6 +13,7 @@ {"name":"echo","pass":7,"total":7,"status":"ok"}, {"name":"fib","pass":8,"total":8,"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"} ] } diff --git a/lib/erlang/scoreboard.md b/lib/erlang/scoreboard.md index bd4087cc..e83b5e9a 100644 --- a/lib/erlang/scoreboard.md +++ b/lib/erlang/scoreboard.md @@ -1,6 +1,6 @@ # Erlang-on-SX Scoreboard -**Total: 761 / 761 tests passing** +**Total: 766 / 766 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -15,6 +15,7 @@ | ✅ | fib | 8 | 8 | | ✅ | ffi | 37 | 37 | | ✅ | vm | 78 | 78 | +| ✅ | send_after | 5 | 5 | Generated by `lib/erlang/conformance.sh`. diff --git a/lib/erlang/tests/send_after.sx b/lib/erlang/tests/send_after.sx new file mode 100644 index 00000000..1a83eff8 --- /dev/null +++ b/lib/erlang/tests/send_after.sx @@ -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") diff --git a/lib/erlang/transpile.sx b/lib/erlang/transpile.sx index 12e14b6f..52b99c6c 100644 --- a/lib/erlang/transpile.sx +++ b/lib/erlang/transpile.sx @@ -1147,7 +1147,7 @@ (and (er-atom? ms) (= (get ms :name) "infinity")) (er-eval-receive-loop 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. (define @@ -1161,12 +1161,15 @@ (get r :value) (er-eval-body (get node :after-body) env))))) -;; after Ms — suspend; on resume check :timed-out. When the scheduler -;; runs out of other work it fires one pending timeout per round. +;; after Ms — suspend with an absolute `deadline` (logical ms). On +;; 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 er-eval-receive-timed (fn - (node pid env) + (node pid env deadline) (let ((r (er-try-receive (get node :clauses) pid env))) (if @@ -1174,6 +1177,7 @@ (get r :value) (do (er-proc-set! pid :has-timeout true) + (er-proc-set! pid :timeout-deadline deadline) (call/cc (fn (k) @@ -1186,7 +1190,7 @@ (er-proc-set! pid :timed-out false) (er-proc-set! pid :has-timeout false) (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. ;; On first match: remove that msg from mailbox and return body value.