From cf597f1b5f2a55ad4210b6d7d6d1dc9b36b04250 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 14 May 2026 22:29:50 +0000 Subject: [PATCH] =?UTF-8?q?vm-ext:=20phase=20A=20=E2=80=94=20extension=20d?= =?UTF-8?q?ispatch=20fallthrough=20in=20sx=5Fvm.ml?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- hosts/ocaml/bin/run_tests.ml | 43 ++++++++++++++++++++++++++++++++- hosts/ocaml/lib/sx_vm.ml | 22 +++++++++++++++++ plans/sx-vm-opcode-extension.md | 23 +++++++++++++++--- 3 files changed, 83 insertions(+), 5 deletions(-) diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 214bf90d..b9f0c0a1 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -1282,7 +1282,48 @@ let run_foundation_tests () = let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None; l_call_count = 0; l_uid = Sx_types.next_lambda_uid () } in assert_true "is_lambda" (Bool (Sx_types.is_lambda (Lambda l))); ignore (Sx_types.set_lambda_name (Lambda l) "my-fn"); - assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l)) + assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l)); + + Printf.printf "\nSuite: vm-extension-dispatch\n"; + let make_bc op = ({ + vc_arity = 0; vc_rest_arity = -1; vc_locals = 0; + vc_bytecode = [| op |]; vc_constants = [||]; + vc_bytecode_list = None; vc_constants_list = None; + } : Sx_types.vm_code) in + let expect_invalid_opcode label op = + let globals = Hashtbl.create 1 in + try + let _ = Sx_vm.execute_module (make_bc op) globals in + incr fail_count; + Printf.printf " FAIL: %s — expected Invalid_opcode, got a result\n" label + with + | Sx_vm.Invalid_opcode n when n = op -> + incr pass_count; + Printf.printf " PASS: %s\n" label + | exn -> + incr fail_count; + Printf.printf " FAIL: %s — unexpected: %s\n" label (Printexc.to_string exn) + in + expect_invalid_opcode "opcode 200 raises Invalid_opcode 200" 200; + expect_invalid_opcode "opcode 224 raises Invalid_opcode 224" 224; + expect_invalid_opcode "opcode 247 raises Invalid_opcode 247" 247; + (* Opcode 199 sits just below the extension threshold — should fall to the + catch-all (Eval_error), proving the threshold is at 200, not 199. *) + let globals = Hashtbl.create 1 in + (try + let _ = Sx_vm.execute_module (make_bc 199) globals in + incr fail_count; + Printf.printf " FAIL: opcode 199 — expected Eval_error, got a result\n" + with + | Sx_vm.Invalid_opcode _ -> + incr fail_count; + Printf.printf " FAIL: opcode 199 routed to extension dispatch (threshold wrong)\n" + | Sx_types.Eval_error _ -> + incr pass_count; + Printf.printf " PASS: opcode 199 stays in core (catch-all)\n" + | exn -> + incr fail_count; + Printf.printf " FAIL: opcode 199 — unexpected: %s\n" (Printexc.to_string exn)) (* ====================================================================== *) diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index 96d28075..ae1396c4 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -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. *) @@ -875,6 +888,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))) diff --git a/plans/sx-vm-opcode-extension.md b/plans/sx-vm-opcode-extension.md index 6b727c71..be06cd33 100644 --- a/plans/sx-vm-opcode-extension.md +++ b/plans/sx-vm-opcode-extension.md @@ -237,13 +237,13 @@ Five sub-phases in dependency order. Each is testable in isolation. ### Phase A — Opcode ID partition + dispatch fallthrough -- [ ] Define `exception Invalid_opcode of int` in `sx_vm.ml`. -- [ ] Add `extension_dispatch_ref : (int -> vm -> frame -> unit) ref` +- [x] Define `exception Invalid_opcode of int` in `sx_vm.ml`. +- [x] Add `extension_dispatch_ref : (int -> vm -> frame -> unit) ref` whose default handler raises `Invalid_opcode op`. Forward-declared in the same style as the existing `jit_compile_ref`. -- [ ] Add `| op when op >= 200 -> !extension_dispatch_ref op vm frame` arm +- [x] Add `| op when op >= 200 -> !extension_dispatch_ref op vm frame` arm in the dispatch loop, immediately before the catch-all. -- [ ] Document the partition in a comment near the top of the opcode list. +- [x] Document the partition in a comment near the top of the opcode list. **Tests:** - All existing OCaml VM/CEK tests pass unchanged (zero regression for core). @@ -457,3 +457,18 @@ familiarity. Newest first. +- **2026-05-14** — Phase A done. Added `Invalid_opcode of int` exception, + `extension_dispatch_ref` (default raises `Invalid_opcode op`), and the + `| op when op >= 200 -> !extension_dispatch_ref op vm frame` arm before the + catch-all in `sx_vm.ml`. Partition comment documents 1-199 core / 200-247 + extensions / 248-255 reserved (current core ceiling is OP_DEC = 175). + 4 new foundation tests (3 × Invalid_opcode for opcodes 200/224/247, 1 × + Eval_error for opcode 199 to pin the threshold). Foundation 64/64; + full OCaml test suite +4 pass vs baseline (4807 vs 4803), 1111 pre-existing + failures unchanged. Conformance suites green: erlang 530/530, haskell + 285/285, datalog 276/276, prolog 590/590, smalltalk 847/847, common-lisp + 305/305, apl 562/562, js 148/148, forth 632/638 (pre-existing), tcl 3/4 + (pre-existing), ocaml-on-sx unit 607/607. (Lua 0/16 and ocaml-conformance + baseline programs not exercised — pre-existing scoreboard state and + multi-hour runtime respectively.) +