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:
@@ -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
|
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)));
|
assert_true "is_lambda" (Bool (Sx_types.is_lambda (Lambda l)));
|
||||||
ignore (Sx_types.set_lambda_name (Lambda l) "my-fn");
|
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))
|
||||||
|
|
||||||
|
|
||||||
(* ====================================================================== *)
|
(* ====================================================================== *)
|
||||||
|
|||||||
@@ -44,6 +44,11 @@ type vm = {
|
|||||||
ip past OP_PERFORM, stack ready for a result push). *)
|
ip past OP_PERFORM, stack ready for a result push). *)
|
||||||
exception VmSuspended of value * vm
|
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
|
(* Register the VM suspension converter so sx_runtime.sx_apply_cek can
|
||||||
catch VmSuspended and convert it to CekPerformRequest without a
|
catch VmSuspended and convert it to CekPerformRequest without a
|
||||||
direct dependency on this module. *)
|
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 =
|
let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
|
||||||
ref (fun _ _ -> None)
|
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
|
(* JIT threshold and counters live in Sx_types so primitives can read them
|
||||||
without creating a sx_primitives → sx_vm dependency cycle. *)
|
without creating a sx_primitives → sx_vm dependency cycle. *)
|
||||||
|
|
||||||
@@ -875,6 +888,15 @@ and run vm =
|
|||||||
let request = pop vm in
|
let request = pop vm in
|
||||||
raise (VmSuspended (request, vm))
|
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 ->
|
| opcode ->
|
||||||
raise (Eval_error (Printf.sprintf "VM: unknown opcode %d at ip=%d"
|
raise (Eval_error (Printf.sprintf "VM: unknown opcode %d at ip=%d"
|
||||||
opcode (frame.ip - 1)))
|
opcode (frame.ip - 1)))
|
||||||
|
|||||||
@@ -237,13 +237,13 @@ Five sub-phases in dependency order. Each is testable in isolation.
|
|||||||
|
|
||||||
### Phase A — Opcode ID partition + dispatch fallthrough
|
### Phase A — Opcode ID partition + dispatch fallthrough
|
||||||
|
|
||||||
- [ ] Define `exception Invalid_opcode of int` in `sx_vm.ml`.
|
- [x] Define `exception Invalid_opcode of int` in `sx_vm.ml`.
|
||||||
- [ ] Add `extension_dispatch_ref : (int -> vm -> frame -> unit) ref`
|
- [x] Add `extension_dispatch_ref : (int -> vm -> frame -> unit) ref`
|
||||||
whose default handler raises `Invalid_opcode op`. Forward-declared in
|
whose default handler raises `Invalid_opcode op`. Forward-declared in
|
||||||
the same style as the existing `jit_compile_ref`.
|
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.
|
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:**
|
**Tests:**
|
||||||
- All existing OCaml VM/CEK tests pass unchanged (zero regression for core).
|
- All existing OCaml VM/CEK tests pass unchanged (zero regression for core).
|
||||||
@@ -457,3 +457,18 @@ familiarity.
|
|||||||
|
|
||||||
Newest first.
|
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.)
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user