vm-ext: skip JIT for guard/handler-bind functions (recursive PUSH_HANDLER scan)

The host combined-binary integration test exposed a new JIT-unsafe class:
Dream's error middleware (host/wrap-errors -> dream-catch-with) failed to catch
a thrown error under JIT — it escaped as "Unhandled exception" and truncated the
host middleware suite (7/9 vs 9/9 on CEK).

Root cause: the VM's OP_PUSH_HANDLER (the compiled form of `guard`) only
intercepts a VM-level RAISE (opcode 37); it does NOT catch the OCaml Eval_error
that the `error` primitive throws from a CALL/CALL_PRIM in a callee frame. So a
JIT-compiled `guard` silently fails to catch. dream-catch-with is curried
((fn (on-error) (fn (next) (fn (req) (guard ...))))), so the guard lives in a
NESTED closure — JIT-compiling the outer function mints that inner guard as a
VmClosure with the broken VM handler.

Fix (central, not per-callsite): scan a JIT candidate's bytecode RECURSIVELY —
including nested closure code in the constant pool — for OP_PUSH_HANDLER, and
skip JIT for any handler-installing function. It then runs on the CEK, whose
guard catches correctly. Covers dream-catch-with, host wrap-errors/blog-render,
and every other guard / handler-bind user automatically.

Verified: minimal direct guard and curried cross-frame guard both return the
caught value under JIT (were "Unhandled exception"); the host run's "kaboom"
escapes went 2 -> 0. (Remaining host blog/page failures are "Undefined symbol:
render-page" — the host's native render fn, absent from the standalone
sx_server.exe; identical on CEK, i.e. an environment artifact, not a JIT
regression. The combined host binary has render-page.)

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-20 04:07:02 +00:00
parent bf298684fd
commit 3c13596714

View File

@@ -1089,7 +1089,7 @@ let _jit_is_broken_name n =
Operand-size logic mirrors [opcode_operand_size] (which is defined Operand-size logic mirrors [opcode_operand_size] (which is defined
later, in the disassembly section); inlined here so this helper can later, in the disassembly section); inlined here so this helper can
sit before [jit_compile_lambda] in the file. *) sit before [jit_compile_lambda] in the file. *)
let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) = let bytecode_find_opcode (pred : int -> bool) (bc : int array) (consts : value array) =
let core_operand_size = function let core_operand_size = function
| 1 | 20 | 21 | 64 | 65 | 128 -> 2 (* u16 *) | 1 | 20 | 21 | 64 | 65 | 128 -> 2 (* u16 *)
| 16 | 17 | 18 | 19 | 48 | 49 | 144 -> 1 (* u8 *) | 16 | 17 | 18 | 19 | 48 | 49 | 144 -> 1 (* u8 *)
@@ -1102,7 +1102,7 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
let found = ref false in let found = ref false in
while not !found && !ip < len do while not !found && !ip < len do
let op = bc.(!ip) in let op = bc.(!ip) in
if op >= 200 then found := true if pred op then found := true
else begin else begin
ip := !ip + 1; ip := !ip + 1;
let extra = match op with let extra = match op with
@@ -1129,6 +1129,33 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
done; done;
!found !found
let bytecode_uses_extension_opcodes bc consts =
bytecode_find_opcode (fun op -> op >= 200) bc consts
(** True if [code] — or any closure nested in its constant pool — installs an
exception handler (OP_PUSH_HANDLER = 35), i.e. contains a `guard` /
`handler-bind` / dream-catch form. The VM's PUSH_HANDLER only intercepts a
VM-level RAISE (opcode 37); it does NOT catch the OCaml [Eval_error] that
the `error` primitive throws from inside a CALL/CALL_PRIM in a callee
frame. So a JIT-compiled guard silently fails to catch thrown errors (they
escape across the JIT frame).
The scan is RECURSIVE: a curried higher-order function (e.g. Dream's
`dream-catch-with = (fn (on-error) (fn (next) (fn (req) (guard ...))))`)
has no PUSH_HANDLER in its own body — the guard lives in a nested
`OP_CLOSURE` whose code sits in the constant pool. JIT-compiling the outer
function would mint that inner guard as a VmClosure with the broken VM
handler. Descending into nested closure codes catches this, so the whole
closure family runs on the CEK (whose guard catches correctly). Covers
dream-catch-with, host wrap-errors, and every guard user centrally. *)
let rec code_uses_handler code =
bytecode_find_opcode (fun op -> op = 35) code.vc_bytecode code.vc_constants
|| Array.exists (fun c ->
match c with
| Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
(try code_uses_handler (code_from_value c) with _ -> false)
| _ -> false) code.vc_constants
let jit_compile_lambda (l : lambda) globals = let jit_compile_lambda (l : lambda) globals =
let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in
if !_jit_compiling then ( if !_jit_compiling then (
@@ -1207,6 +1234,13 @@ let jit_compile_lambda (l : lambda) globals =
Printf.eprintf "[jit] SKIP %s: bytecode uses extension opcodes (interpret-only in v1)\n%!" Printf.eprintf "[jit] SKIP %s: bytecode uses extension opcodes (interpret-only in v1)\n%!"
fn_name; fn_name;
None None
end else if code_uses_handler code then begin
(* guard / handler-bind (possibly in a nested closure): VM
PUSH_HANDLER doesn't catch the `error` primitive's OCaml
exception across frames — run on the CEK. *)
Printf.eprintf "[jit] SKIP %s: installs an exception handler (guard) — interpret-only\n%!"
fn_name;
None
end else end else
Some { vm_code = code; vm_upvalues = [||]; Some { vm_code = code; vm_upvalues = [||];
vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure } vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }