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:
@@ -1518,7 +1518,86 @@ let run_foundation_tests () =
|
||||
Printf.printf " FAIL: integer arg should have raised\n"
|
||||
with Sx_types.Eval_error _ ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: integer arg rejected\n")
|
||||
Printf.printf " PASS: integer arg rejected\n");
|
||||
|
||||
Printf.printf "\nSuite: extensions/test_ext (canonical extension)\n";
|
||||
(* Phase D: the real test extension lives at lib/extensions/test_ext.ml.
|
||||
Register it on top of the inline test_reg from earlier suites — the
|
||||
two use disjoint opcode IDs (210/211 vs 220/221) so they coexist. *)
|
||||
Test_ext.register ();
|
||||
|
||||
(* Lookup via the public primitive should now find OP_TEST_PUSH_42. *)
|
||||
(match prim [String "test_ext.OP_TEST_PUSH_42"] with
|
||||
| Integer 220 ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: extension-opcode-id finds test_ext.OP_TEST_PUSH_42\n"
|
||||
| other ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: opcode lookup: got %s\n" (Sx_types.inspect other));
|
||||
|
||||
(* End-to-end: PUSH_42 + DOUBLE_TOS + RETURN. *)
|
||||
(let globals = Hashtbl.create 1 in
|
||||
try
|
||||
match Sx_vm.execute_module (make_bc_seq [| 220; 221; 50 |]) globals with
|
||||
| Integer 84 ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: extensions/test_ext bytecode executes (84)\n"
|
||||
| other ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: test_ext bytecode result: got %s\n"
|
||||
(Sx_types.inspect other)
|
||||
with exn ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: test_ext bytecode raised: %s\n"
|
||||
(Printexc.to_string exn));
|
||||
|
||||
(* Disassembly: opcode_name should resolve 220/221 via the registry,
|
||||
not fall back to UNKNOWN_220 / UNKNOWN_221. disassemble returns a
|
||||
Dict; the instruction list lives at key "bytecode". *)
|
||||
(let code = make_bc_seq [| 220; 221; 50 |] in
|
||||
let dis = Sx_vm.disassemble code in
|
||||
let entries = match dis with
|
||||
| Dict d -> (match Hashtbl.find_opt d "bytecode" with
|
||||
| Some (List es) -> es
|
||||
| _ -> [])
|
||||
| _ -> []
|
||||
in
|
||||
let names = List.filter_map (fun entry -> match entry with
|
||||
| Dict d ->
|
||||
(match Hashtbl.find_opt d "opcode" with
|
||||
| Some (String name) -> Some name
|
||||
| _ -> None)
|
||||
| _ -> None) entries
|
||||
in
|
||||
let has name = List.mem name names in
|
||||
if has "test_ext.OP_TEST_PUSH_42" && has "test_ext.OP_TEST_DOUBLE_TOS" then begin
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: disassemble shows extension opcode names\n"
|
||||
end else begin
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: disassemble names: [%s]\n" (String.concat ", " names)
|
||||
end);
|
||||
|
||||
(* Sanity: opcode_name on an unregistered extension opcode still
|
||||
returns UNKNOWN_n. Pick 230 — out of test_ext's range. *)
|
||||
(match Sx_vm.opcode_name 230 with
|
||||
| "UNKNOWN_230" ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: unregistered ext opcode falls back to UNKNOWN_n\n"
|
||||
| other ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: opcode_name 230: got %s\n" other);
|
||||
|
||||
(* Per-extension state: invocation_count should reflect the two opcodes
|
||||
that ran in the dispatch test above. *)
|
||||
(match Test_ext.invocation_count () with
|
||||
| Some n when n >= 2 ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: extension state recorded %d invocations\n" n
|
||||
| other ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: invocation_count: %s\n"
|
||||
(match other with Some n -> string_of_int n | None -> "None"))
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
|
||||
Reference in New Issue
Block a user