Stub VM uses real globals for CEK resume after IO suspension
The _cek_io_suspend_hook creates a stub VM to carry the suspended CEK state. Previously used empty globals, which caused "Not callable: nil" when the CEK resume needed platform functions. Now uses _default_vm_globals (set to _vm_globals by sx_browser.ml) so all platform functions and definitions are available during resume. Remaining issue: still getting "resume: Not callable: nil" — the CEK continuation env may not include letrec bindings from the island body. The suspension point is inside reload-frame → hs-wait, and the resume needs to call wait-boot (a letrec binding). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -237,6 +237,7 @@ let return_via_side_channel (v : Js.Unsafe.any) : Js.Unsafe.any =
|
||||
VmClosures from bytecode modules hold vm_env_ref pointing here.
|
||||
Must stay in sync so VmClosures see post-boot definitions. *)
|
||||
let _vm_globals : (string, value) Hashtbl.t = Hashtbl.create 512
|
||||
let () = Sx_types._default_vm_globals := _vm_globals
|
||||
let _in_batch = ref false
|
||||
|
||||
(* Sync env→VM: copy all bindings from global_env.bindings to _vm_globals.
|
||||
|
||||
@@ -258,6 +258,10 @@ let _cek_io_resolver : (value -> value -> value) option ref = ref None
|
||||
to convert CEK suspensions to VmSuspended for _driveAsync handling. *)
|
||||
let _cek_io_suspend_hook : (value -> value) option ref = ref None
|
||||
|
||||
(** Default VM globals for stub VMs created during IO suspension.
|
||||
Set by sx_browser.ml to _vm_globals so CEK resume can access platform functions. *)
|
||||
let _default_vm_globals : (string, value) Hashtbl.t ref = ref (Hashtbl.create 0)
|
||||
|
||||
(** Hook: convert VM suspension exceptions to CekPerformRequest.
|
||||
Set by sx_vm after it defines VmSuspended. Called by sx_runtime.sx_apply_cek. *)
|
||||
let _convert_vm_suspension : (exn -> unit) ref = ref (fun _ -> ())
|
||||
|
||||
@@ -1027,7 +1027,7 @@ let () = _vm_suspension_to_dict := (fun exn ->
|
||||
gets swallowed as "IO suspension in non-IO context". *)
|
||||
let () = _cek_io_suspend_hook := Some (fun suspended_state ->
|
||||
let request = Sx_ref.cek_io_request suspended_state in
|
||||
let vm = create (Hashtbl.create 0) in
|
||||
let vm = create !_default_vm_globals in
|
||||
vm.pending_cek <- Some suspended_state;
|
||||
raise (VmSuspended (request, vm)))
|
||||
|
||||
|
||||
@@ -1035,7 +1035,15 @@
|
||||
((fn-expr (hs-to-sx (nth ast 1)))
|
||||
(args (map hs-to-sx (nth ast 2))))
|
||||
(cons fn-expr args)))
|
||||
((= head (quote return)) (hs-to-sx (nth ast 1)))
|
||||
((= head (quote return))
|
||||
(let
|
||||
((val (nth ast 1)))
|
||||
(if
|
||||
(nil? val)
|
||||
(list (quote raise) (list (quote list) "hs-return" nil))
|
||||
(list
|
||||
(quote raise)
|
||||
(list (quote list) "hs-return" (hs-to-sx val))))))
|
||||
((= head (quote throw))
|
||||
(list (quote raise) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote settle))
|
||||
@@ -1106,13 +1114,41 @@
|
||||
(quote hs-init)
|
||||
(list (quote fn) (list) (hs-to-sx (nth ast 1)))))
|
||||
((= head (quote def))
|
||||
(list
|
||||
(quote define)
|
||||
(make-symbol (nth ast 1))
|
||||
(let
|
||||
((body (hs-to-sx (nth ast 3)))
|
||||
(params
|
||||
(map
|
||||
(fn
|
||||
(p)
|
||||
(if
|
||||
(and (list? p) (= (first p) (quote ref)))
|
||||
(make-symbol (nth p 1))
|
||||
(make-symbol p)))
|
||||
(nth ast 2))))
|
||||
(list
|
||||
(quote fn)
|
||||
(map make-symbol (nth ast 2))
|
||||
(hs-to-sx (nth ast 3)))))
|
||||
(quote define)
|
||||
(make-symbol (nth ast 1))
|
||||
(list
|
||||
(quote fn)
|
||||
params
|
||||
(list
|
||||
(quote guard)
|
||||
(list
|
||||
(quote _e)
|
||||
(list
|
||||
(quote true)
|
||||
(list
|
||||
(quote if)
|
||||
(list
|
||||
(quote and)
|
||||
(list (quote list?) (quote _e))
|
||||
(list
|
||||
(quote =)
|
||||
(list (quote first) (quote _e))
|
||||
"hs-return"))
|
||||
(list (quote nth) (quote _e) 1)
|
||||
(list (quote raise) (quote _e)))))
|
||||
body)))))
|
||||
((= head (quote behavior)) (emit-behavior ast))
|
||||
((= head (quote sx-eval))
|
||||
(let
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1792,7 +1792,7 @@
|
||||
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
|
||||
}
|
||||
(globalThis))
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-5ce001fe",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-8afc1869",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-da652b03",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-def18509",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
|
||||
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
|
||||
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
|
||||
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new
|
||||
|
||||
Reference in New Issue
Block a user