vm-ext: phase A — extension dispatch fallthrough in sx_vm.ml

Adds Invalid_opcode of int exception and extension_dispatch_ref forward
ref (default raises Invalid_opcode op), plus the |op when op >= 200 arm
before the catch-all in the bytecode dispatch loop. Partition comment
documents 1-199 core / 200-247 extensions / 248-255 reserved.

Phase B will install the real registry's dispatch into the ref at module
init, replacing this stub.

Tests: 4 new foundation cases (Invalid_opcode for 200/224/247, Eval_error
for 199 to pin the threshold). +4 pass vs baseline, no regressions.
This commit is contained in:
2026-05-14 22:29:50 +00:00
parent 64b7263c5f
commit 85728621b0
2 changed files with 64 additions and 1 deletions

View File

@@ -44,6 +44,11 @@ type vm = {
ip past OP_PERFORM, stack ready for a result push). *)
exception VmSuspended of value * vm
(** Raised by the extension dispatch fallthrough when an opcode in the
extension range (≥ 200) is encountered with no handler registered.
Carries the offending opcode id. See plans/sx-vm-opcode-extension.md. *)
exception Invalid_opcode of int
(* Register the VM suspension converter so sx_runtime.sx_apply_cek can
catch VmSuspended and convert it to CekPerformRequest without a
direct dependency on this module. *)
@@ -57,6 +62,14 @@ let () = Sx_types._convert_vm_suspension := (fun exn ->
let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
ref (fun _ _ -> None)
(** Forward reference for extension opcode dispatch — Phase B installs the
real registry's dispatch function here at module init. Until then, any
opcode in the extension range raises [Invalid_opcode]. Same forward-ref
pattern as [jit_compile_ref] above; keeps [Sx_vm_extensions] free to
depend on [Sx_vm]'s [vm] / [frame] types without a cycle. *)
let extension_dispatch_ref : (int -> vm -> frame -> unit) ref =
ref (fun op _vm _frame -> raise (Invalid_opcode op))
(* JIT threshold and counters live in Sx_types so primitives can read them
without creating a sx_primitives → sx_vm dependency cycle. *)
@@ -867,6 +880,15 @@ and run vm =
let request = pop vm in
raise (VmSuspended (request, vm))
(* ---- Extension dispatch fallthrough ----
Opcode partition (see plans/sx-vm-opcode-extension.md):
0 reserved / NOP
1-199 core opcodes (current ceiling 175 = OP_DEC)
200-247 extension opcodes (registered via Sx_vm_extensions)
248-255 reserved for future expansion / multi-byte
Any opcode ≥ 200 routes through the extension registry. *)
| op when op >= 200 -> !extension_dispatch_ref op vm frame
| opcode ->
raise (Eval_error (Printf.sprintf "VM: unknown opcode %d at ip=%d"
opcode (frame.ip - 1)))