vm-ext: phase D — extensions/ subtree + test_ext + opcode_name lookup
lib/extensions/ becomes the new home for VM extensions, wired in via (include_subdirs unqualified). README documents the registration pattern, opcode-ID range conventions (200-209 guest_vm, 210-219 inline test, 220-229 test_ext, 230-247 ports), and naming rules. extensions/test_ext.ml is the canonical worked example — two operand-less opcodes (220 push 42, 221 double TOS) carrying a per- extension state slot (TestExtState invocation counter). Test_ext.register called from run_tests.ml at the start of the Phase D suite, on top of the inline test_reg from earlier suites (disjoint opcode IDs). Sx_vm.opcode_name now consults extension_opcode_name_ref (forward ref in the same style as extension_dispatch_ref), so disassemble shows extension opcodes by name instead of UNKNOWN_n. Registry maintains name_of_id_table and installs the lookup at module init. Tests: 5 new foundation cases — primitive resolves test_ext name, end-to-end bytecode (push + double + return → 84), disassemble shows "test_ext.OP_TEST_PUSH_42" / "test_ext.OP_TEST_DOUBLE_TOS", unregistered ext opcodes still fall back to UNKNOWN_n, invocation counter records the two dispatches. +5 pass vs Phase C baseline, no regressions across 11 conformance suites.
This commit is contained in:
67
hosts/ocaml/lib/extensions/test_ext.ml
Normal file
67
hosts/ocaml/lib/extensions/test_ext.ml
Normal file
@@ -0,0 +1,67 @@
|
||||
(** {1 [test_ext] — canonical example VM extension}
|
||||
|
||||
A minimal extension demonstrating the registration pattern from
|
||||
[plans/sx-vm-opcode-extension.md]. The opcode IDs (220, 221) sit at
|
||||
the top of the extension range, well clear of anything a real
|
||||
language port would claim.
|
||||
|
||||
Two operand-less opcodes:
|
||||
|
||||
- [test_ext.OP_TEST_PUSH_42] (220) — pushes the integer 42.
|
||||
- [test_ext.OP_TEST_DOUBLE_TOS] (221) — pops the integer on TOS,
|
||||
pushes 2× it.
|
||||
|
||||
These are the smallest stack manipulations that prove the extension
|
||||
mechanism wires through end-to-end (registry → dispatch → human-
|
||||
readable disassembly). Real ports (Erlang Phase 9, future Haskell
|
||||
perf phases) replace this template with their own opcode set.
|
||||
|
||||
Loading: [Test_ext.register ()] adds the extension to
|
||||
[Sx_vm_extensions]. Run-time binaries that want the test opcodes
|
||||
available call this once at startup. Unit tests in
|
||||
[bin/run_tests.ml] do exactly that. *)
|
||||
|
||||
open Sx_types
|
||||
|
||||
(** Per-instance state for [test_ext]. Counts how many times the
|
||||
handlers ran — purely so the extension has *some* state, exercising
|
||||
the [extension_state] machinery. *)
|
||||
type Sx_vm_extension.extension_state += TestExtState of {
|
||||
mutable invocations : int;
|
||||
}
|
||||
|
||||
module M : Sx_vm_extension.EXTENSION = struct
|
||||
let name = "test_ext"
|
||||
let init () = TestExtState { invocations = 0 }
|
||||
|
||||
let opcodes st =
|
||||
let bump () = match st with
|
||||
| TestExtState s -> s.invocations <- s.invocations + 1
|
||||
| _ -> ()
|
||||
in
|
||||
[
|
||||
(220, "test_ext.OP_TEST_PUSH_42",
|
||||
(fun vm _frame -> bump (); Sx_vm.push vm (Integer 42)));
|
||||
|
||||
(221, "test_ext.OP_TEST_DOUBLE_TOS",
|
||||
(fun vm _frame ->
|
||||
bump ();
|
||||
let v = Sx_vm.pop vm in
|
||||
match v with
|
||||
| Integer n -> Sx_vm.push vm (Integer (n * 2))
|
||||
| _ -> raise (Eval_error
|
||||
"test_ext.OP_TEST_DOUBLE_TOS: TOS is not an integer")));
|
||||
]
|
||||
end
|
||||
|
||||
(** Register [test_ext] in [Sx_vm_extensions]. Idempotent only by
|
||||
failing loudly — calling twice raises [Failure]. Binaries call this
|
||||
once at startup; tests may [_reset_for_tests] then re-register. *)
|
||||
let register () = Sx_vm_extensions.register (module M : Sx_vm_extension.EXTENSION)
|
||||
|
||||
(** Read the invocation counter from the live registry state. Returns
|
||||
[None] if [register] hasn't been called yet. *)
|
||||
let invocation_count () =
|
||||
match Sx_vm_extensions.state_of_extension "test_ext" with
|
||||
| Some (TestExtState s) -> Some s.invocations
|
||||
| _ -> None
|
||||
Reference in New Issue
Block a user