sx: step 2 — restore frame locals on browser VmSuspension resume
In `resume_vm`'s `restore_reuse`, the saved sp captured by `call_closure_reuse` was ignored when restoring the caller frame after the async callback finished. The suspended callee's locals/temps stayed on the value stack above saved_sp, so subsequent LOCAL_GET/SET in the caller frame (e.g. letrec sibling bindings waiting on the suspending call) read stale callee data instead of their own slots. Sibling bindings appeared nil after a perform/resume cycle on the JIT path used by the WASM browser kernel. Fix: after popping the callback result and restoring saved_frames, reset `vm.sp <- saved_sp` (when sp is above), then push the callback result. Mirrors the OP_RETURN+sp-reset discipline that sync `call_closure_reuse` already follows. New tests in `spec/tests/test-letrec-resume.sx` cover single binding, sibling bindings, mutual recursion siblings, and nested letrec — all four pass. Full OCaml run_tests: 4529/5868 (was 4525/5864), zero regressions. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -896,9 +896,17 @@ let resume_vm vm result =
|
|||||||
let rec restore_reuse pending =
|
let rec restore_reuse pending =
|
||||||
match pending with
|
match pending with
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| (saved_frames, _saved_sp) :: rest ->
|
| (saved_frames, saved_sp) :: rest ->
|
||||||
let callback_result = pop vm in
|
let callback_result = pop vm in
|
||||||
vm.frames <- saved_frames;
|
vm.frames <- saved_frames;
|
||||||
|
(* Restore sp to the value captured before the suspended callee was
|
||||||
|
pushed. The callee's locals/temps may still be on the stack above
|
||||||
|
saved_sp; without this reset, subsequent LOCAL_GET/SET in the
|
||||||
|
caller frame (e.g. letrec sibling bindings waiting on the call)
|
||||||
|
see stale callee data instead of their own slots. Mirrors the
|
||||||
|
OP_RETURN+sp-reset semantics that sync `call_closure_reuse`
|
||||||
|
relies on for clean caller-frame state. *)
|
||||||
|
if saved_sp < vm.sp then vm.sp <- saved_sp;
|
||||||
push vm callback_result;
|
push vm callback_result;
|
||||||
(try
|
(try
|
||||||
run vm;
|
run vm;
|
||||||
|
|||||||
@@ -182,7 +182,7 @@ these when operands are known numbers/lists.
|
|||||||
| Step | Status | Commit |
|
| Step | Status | Commit |
|
||||||
|------|--------|--------|
|
|------|--------|--------|
|
||||||
| 1 — JIT combinator bug | [x] | 882a4b76 |
|
| 1 — JIT combinator bug | [x] | 882a4b76 |
|
||||||
| 2 — letrec+resume | [ ] | — |
|
| 2 — letrec+resume | [x] | (pending) |
|
||||||
| 3 — tokenizer :end/:line | [ ] | — |
|
| 3 — tokenizer :end/:line | [ ] | — |
|
||||||
| 4 — parser spans complete | [ ] | — |
|
| 4 — parser spans complete | [ ] | — |
|
||||||
| 5 — OCaml AdtValue + define-type + match | [ ] | — |
|
| 5 — OCaml AdtValue + define-type + match | [ ] | — |
|
||||||
|
|||||||
44
spec/tests/test-letrec-resume.sx
Normal file
44
spec/tests/test-letrec-resume.sx
Normal file
@@ -0,0 +1,44 @@
|
|||||||
|
;; Letrec + perform/resume regression tests — Step 2
|
||||||
|
;; Verifies sibling bindings survive across an IO suspension when the
|
||||||
|
;; suspended call goes through call_closure_reuse (JIT path).
|
||||||
|
;; The browser/WASM kernel reuses the host VM via call_closure_reuse;
|
||||||
|
;; if restore_reuse drops the caller's saved sp, sibling letrec bindings
|
||||||
|
;; come back as nil after resume.
|
||||||
|
(defsuite
|
||||||
|
"letrec-resume"
|
||||||
|
(deftest
|
||||||
|
"single binding survives perform/resume"
|
||||||
|
(let
|
||||||
|
((state (cek-step-loop (make-cek-state (quote (letrec ((f (fn () (perform {:op "io"})))) (f))) (make-env) (list)))))
|
||||||
|
(assert (cek-suspended? state))
|
||||||
|
(let
|
||||||
|
((final (cek-resume state 7)))
|
||||||
|
(assert (cek-terminal? final))
|
||||||
|
(assert= (cek-value final) 7))))
|
||||||
|
(deftest
|
||||||
|
"sibling bindings survive perform/resume"
|
||||||
|
(let
|
||||||
|
((state (cek-step-loop (make-cek-state (quote (letrec ((g (fn () 100)) (f (fn () (perform {:op "io"})))) (+ (f) (g)))) (make-env) (list)))))
|
||||||
|
(assert (cek-suspended? state))
|
||||||
|
(let
|
||||||
|
((final (cek-resume state 5)))
|
||||||
|
(assert (cek-terminal? final))
|
||||||
|
(assert= (cek-value final) 105))))
|
||||||
|
(deftest
|
||||||
|
"mutual recursion sibling preserved across resume"
|
||||||
|
(let
|
||||||
|
((state (cek-step-loop (make-cek-state (quote (letrec ((even? (fn (n) (if (= n 0) true (odd? (- n 1))))) (odd? (fn (n) (if (= n 0) false (even? (- n 1))))) (fetch (fn () (perform {:op "io"})))) (let ((x (fetch))) (even? x)))) (make-env) (list)))))
|
||||||
|
(assert (cek-suspended? state))
|
||||||
|
(let
|
||||||
|
((final (cek-resume state 4)))
|
||||||
|
(assert (cek-terminal? final))
|
||||||
|
(assert= (cek-value final) true))))
|
||||||
|
(deftest
|
||||||
|
"nested letrec — outer sibling survives inner perform"
|
||||||
|
(let
|
||||||
|
((state (cek-step-loop (make-cek-state (quote (letrec ((outer-val (fn () 99)) (inner-call (fn () (letrec ((suspend-fn (fn () (perform {:op "io"})))) (suspend-fn))))) (+ (inner-call) (outer-val)))) (make-env) (list)))))
|
||||||
|
(assert (cek-suspended? state))
|
||||||
|
(let
|
||||||
|
((final (cek-resume state 1)))
|
||||||
|
(assert (cek-terminal? final))
|
||||||
|
(assert= (cek-value final) 100)))))
|
||||||
Reference in New Issue
Block a user