diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index bce21648..f15ba252 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -1089,7 +1089,7 @@ let _jit_is_broken_name n = Operand-size logic mirrors [opcode_operand_size] (which is defined later, in the disassembly section); inlined here so this helper can 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 | 1 | 20 | 21 | 64 | 65 | 128 -> 2 (* u16 *) | 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 while not !found && !ip < len do let op = bc.(!ip) in - if op >= 200 then found := true + if pred op then found := true else begin ip := !ip + 1; let extra = match op with @@ -1129,6 +1129,33 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) = done; !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 fn_name = match l.l_name with Some n -> n | None -> "" in 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%!" fn_name; 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 Some { vm_code = code; vm_upvalues = [||]; vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }