From c9634ba6497d1844dbd0fd3f48e6f05d09a91ec0 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 16 Apr 2026 13:23:35 +0000 Subject: [PATCH] VM: fix nested IO suspension frame corruption, island hydration preload MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit VM frame merging bug: call_closure_reuse now saves caller continuations on a reuse_stack instead of merging frames. resume_vm restores them in innermost-first order. Fixes frame count corruption when nested closures suspend via OP_PERFORM. Zero test regressions (3924/3924). Island hydration: hydrate-island now looks up components from (global-env) instead of render-env, triggering the symbol resolve hook. Added JS-level preload-island-defs that scans DOM for data-sx-island and loads definitions from the content-addressed manifest BEFORE hydration — avoids K.load reentrancy when the resolve hook fires inside env_get. loadDefinitionByHash: fixed isMultiDefine check — defcomp/defisland bodies containing nested (define ...) forms no longer suppress name insertion. Added K.load return value checking for silent error string returns. sx_browser.ml: resolve hook falls back to global_env.bindings when _vm_globals miss (sync gap). Snapshot reuse_stack alongside pending_cek. Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/browser/sx-platform.js | 46 ++++++++++++++++++++++++-- hosts/ocaml/browser/sx_browser.ml | 4 ++- hosts/ocaml/lib/sx_vm.ml | 53 ++++++++++++++++++++++++------ shared/static/wasm/sx/boot.sx | 3 +- web/boot.sx | 3 +- 5 files changed, 93 insertions(+), 16 deletions(-) diff --git a/hosts/ocaml/browser/sx-platform.js b/hosts/ocaml/browser/sx-platform.js index 15c67d45..64817559 100644 --- a/hosts/ocaml/browser/sx-platform.js +++ b/hosts/ocaml/browser/sx-platform.js @@ -846,7 +846,11 @@ // already contain named (define name ...) forms. var name = _hashToName[hash]; if (name) { - var isMultiDefine = /\(define\s+[a-zA-Z]/.test(rewritten); + // Check if this is a multi-define file (client lib with top-level defines). + // Only top-level (define ...) forms count — nested ones inside defisland/defcomp + // bodies should NOT suppress name insertion. + var startsWithDef = /^\((defcomp|defisland|defmacro)\s/.test(rewritten); + var isMultiDefine = !startsWithDef && /\(define\s+[a-zA-Z]/.test(rewritten); if (!isMultiDefine) { rewritten = rewritten.replace( /^\((defcomp|defisland|defmacro|define)\s/, @@ -856,7 +860,12 @@ } try { - K.load(rewritten); + var loadRv = K.load(rewritten); + if (typeof loadRv === "string" && loadRv.indexOf("Error") >= 0) { + console.warn("[sx] K.load error for", (_hashToName[hash] || hash) + ":", loadRv); + delete _loadedHashes[hash]; + return false; + } _loadedHashes[hash] = true; return true; } catch(e) { @@ -865,11 +874,28 @@ } } + // Eagerly pre-load island definitions from the manifest. + // Called from boot.sx before hydration. Scans the DOM for data-sx-island + // attributes and loads definitions via the content-addressed manifest. + // Unlike __resolve-symbol (called from inside env_get), this runs at the + // top level so K.load can register bindings without reentrancy issues. + K.registerNative("preload-island-defs", function() { + var manifest = loadPageManifest(); + if (!manifest || !manifest.defs) return null; + var els = document.querySelectorAll('[data-sx-island]'); + for (var i = 0; i < els.length; i++) { + var name = "~" + els[i].getAttribute("data-sx-island"); + if (manifest.defs[name] && !_loadedHashes[manifest.defs[name]]) { + loadDefinitionByHash(manifest.defs[name]); + } + } + return null; + }); + // Register the resolve hook — called by the VM when GLOBAL_GET fails K.registerNative("__resolve-symbol", function(args) { var name = args[0]; if (!name) return null; - // Content-addressed resolution — components, libraries, macros var manifest = loadPageManifest(); if (manifest && manifest.defs && manifest.defs[name]) { @@ -918,6 +944,20 @@ K.eval("(process-sx-scripts nil)"); console.log("[sx] sx-hydrate-elements..."); K.eval("(sx-hydrate-elements nil)"); + // Pre-load island definitions from manifest before hydration. + // Must happen at JS level (not from inside SX eval) to avoid + // K.load reentrancy issues with the symbol resolve hook. + var manifest = loadPageManifest(); + if (manifest && manifest.defs) { + var islandEls = document.querySelectorAll("[data-sx-island]"); + for (var ii = 0; ii < islandEls.length; ii++) { + var iname = "~" + islandEls[ii].getAttribute("data-sx-island"); + var ihash = manifest.defs[iname]; + if (ihash && !_loadedHashes[ihash]) { + loadDefinitionByHash(ihash); + } + } + } console.log("[sx] sx-hydrate-islands..."); K.eval("(sx-hydrate-islands nil)"); console.log("[sx] process-elements..."); diff --git a/hosts/ocaml/browser/sx_browser.ml b/hosts/ocaml/browser/sx_browser.ml index 1959b6e8..ec047646 100644 --- a/hosts/ocaml/browser/sx_browser.ml +++ b/hosts/ocaml/browser/sx_browser.ml @@ -269,7 +269,9 @@ let () = (* Check if the symbol appeared in globals after the load *) match Hashtbl.find_opt _vm_globals name with | Some v -> Some v - | None -> None) + | None -> + (* Fallback: check global_env directly if vm_globals missed the sync *) + Hashtbl.find_opt global_env.bindings (Sx_types.intern name)) (* ================================================================== *) (* Core API *) diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index 54995f15..b7c25403 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -36,6 +36,7 @@ type vm = { globals : (string, value) Hashtbl.t; (* live reference to kernel env *) mutable pending_cek : value option; (* suspended CEK state from Component/Lambda call *) mutable handler_stack : handler_entry list; (* exception handler stack *) + mutable reuse_stack : (frame list * int) list; (* saved call_closure_reuse continuations *) } (** Raised when OP_PERFORM is executed. Carries the IO request dict @@ -74,7 +75,7 @@ let is_jit_failed cl = cl.vm_code.vc_arity = -1 let _active_vm : vm option ref = ref None let create globals = - { stack = Array.make 4096 Nil; sp = 0; frames = []; globals; pending_cek = None; handler_stack = [] } + { stack = Array.make 4096 Nil; sp = 0; frames = []; globals; pending_cek = None; handler_stack = []; reuse_stack = [] } (** Stack ops — inlined for speed. *) let push vm v = @@ -313,10 +314,11 @@ and call_closure_reuse cl args = (try run vm with | VmSuspended _ as e -> - (* IO suspension: merge remaining callback frames with caller frames - so the VM can be properly resumed. When resumed, it finishes the - callback then returns to the caller's frames. *) - vm.frames <- vm.frames @ saved_frames; + (* IO suspension: save the caller's continuation on the reuse stack. + DON'T merge frames — that corrupts the frame chain with nested + closures. On resume, restore_reuse in resume_vm processes these + in innermost-first order after the callback finishes. *) + vm.reuse_stack <- (saved_frames, saved_sp) :: vm.reuse_stack; raise e | e -> vm.frames <- saved_frames; @@ -831,7 +833,10 @@ and run vm = done (** Resume a suspended VM by pushing the IO result and continuing. - May raise VmSuspended again if the VM hits another OP_PERFORM. *) + May raise VmSuspended again if the VM hits another OP_PERFORM. + + After the callback finishes, restores any call_closure_reuse + continuations saved on vm.reuse_stack (innermost first). *) let resume_vm vm result = (match vm.pending_cek with | Some cek_state -> @@ -846,6 +851,32 @@ let resume_vm vm result = | None -> push vm result); run vm; + (* Restore call_closure_reuse continuations saved during suspension. + reuse_stack is in catch order (outermost first from prepend) — + reverse to get innermost first, matching callback→caller unwinding. *) + let rec restore_reuse pending = + match pending with + | [] -> () + | (saved_frames, _saved_sp) :: rest -> + let callback_result = pop vm in + vm.frames <- saved_frames; + push vm callback_result; + (try + run vm; + (* Check for new reuse entries added by nested call_closure_reuse *) + let new_pending = List.rev vm.reuse_stack in + vm.reuse_stack <- []; + restore_reuse (new_pending @ rest) + with VmSuspended _ as e -> + (* Re-suspension: save unprocessed entries back for next resume. + rest is innermost-first; vm.reuse_stack is outermost-first. + Combine so next resume's reversal yields: new_inner, old_inner→outer. *) + vm.reuse_stack <- (List.rev rest) @ vm.reuse_stack; + raise e) + in + let pending = List.rev vm.reuse_stack in + vm.reuse_stack <- []; + restore_reuse pending; pop vm (** Execute a compiled module (top-level bytecode). *) @@ -967,18 +998,20 @@ let () = _vm_call_closure_ref := (fun cl args -> call_closure_reuse cl args) let () = _vm_suspension_to_dict := (fun exn -> match exn with | VmSuspended (request, vm) -> - (* Snapshot pending_cek NOW — a nested cek_call_or_suspend on the same VM - may overwrite it before our resume function is called. *) + (* Snapshot pending_cek and reuse_stack NOW — a nested cek_call_or_suspend + on the same VM may overwrite them before our resume function is called. *) let saved_cek = vm.pending_cek in + let saved_reuse = vm.reuse_stack in let d = Hashtbl.create 3 in Hashtbl.replace d "__vm_suspended" (Bool true); Hashtbl.replace d "request" request; Hashtbl.replace d "resume" (NativeFn ("vm-resume", fun args -> match args with | [result] -> - (* Restore the saved pending_cek before resuming — it may have been - overwritten by a nested suspension on the same VM. *) + (* Restore saved state before resuming — may have been overwritten + by a nested suspension on the same VM. *) vm.pending_cek <- saved_cek; + vm.reuse_stack <- saved_reuse; (try resume_vm vm result with exn2 -> match !_vm_suspension_to_dict exn2 with diff --git a/shared/static/wasm/sx/boot.sx b/shared/static/wasm/sx/boot.sx index 2dd9ab6c..a5b319d1 100644 --- a/shared/static/wasm/sx/boot.sx +++ b/shared/static/wasm/sx/boot.sx @@ -280,6 +280,7 @@ (root) (let ((els (dom-query-all (or root (dom-body)) "[data-sx-island]"))) + (preload-island-defs) (log-info (str "sx-hydrate-islands: " @@ -313,7 +314,7 @@ (let ((comp-name (str "~" name)) (env (get-render-env nil))) (let - ((comp (env-get env comp-name))) + ((comp (env-get (global-env) comp-name))) (if (not (or (component? comp) (island? comp))) (log-warn (str "hydrate-island: unknown island " comp-name)) diff --git a/web/boot.sx b/web/boot.sx index 2dd9ab6c..a5b319d1 100644 --- a/web/boot.sx +++ b/web/boot.sx @@ -280,6 +280,7 @@ (root) (let ((els (dom-query-all (or root (dom-body)) "[data-sx-island]"))) + (preload-island-defs) (log-info (str "sx-hydrate-islands: " @@ -313,7 +314,7 @@ (let ((comp-name (str "~" name)) (env (get-render-env nil))) (let - ((comp (env-get env comp-name))) + ((comp (env-get (global-env) comp-name))) (if (not (or (component? comp) (island? comp))) (log-warn (str "hydrate-island: unknown island " comp-name))