From 72896392c866f50b53054be2f2f90241fabefd5e Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 15 May 2026 08:24:57 +0000 Subject: [PATCH] =?UTF-8?q?erlang:=20Phase=209h=20=E2=80=94=20erlang=5Fext?= =?UTF-8?q?.ml=20OCaml=20extension=20(opcodes=20222-239,=20registered=20at?= =?UTF-8?q?=20startup)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- hosts/ocaml/bin/run_tests.ml | 64 +++++++++++++++ hosts/ocaml/bin/sx_server.ml | 6 ++ hosts/ocaml/lib/extensions/erlang_ext.ml | 99 ++++++++++++++++++++++++ 3 files changed, 169 insertions(+) create mode 100644 hosts/ocaml/lib/extensions/erlang_ext.ml diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index d3f7afb9..4c3cc5c6 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -1599,6 +1599,70 @@ let run_foundation_tests () = Printf.printf " FAIL: invocation_count: %s\n" (match other with Some n -> string_of_int n | None -> "None")); + Printf.printf "\nSuite: extensions/erlang_ext (Phase 9h)\n"; + (* Register the Erlang opcode namespace. Disjoint id range (200-217) + from test_ext (220/221) so they coexist. *) + Erlang_ext.register (); + + (match prim [String "erlang.OP_PATTERN_TUPLE"] with + | Integer 222 -> + incr pass_count; + Printf.printf " PASS: extension-opcode-id erlang.OP_PATTERN_TUPLE = 222\n" + | other -> + incr fail_count; + Printf.printf " FAIL: erlang.OP_PATTERN_TUPLE: got %s\n" + (Sx_types.inspect other)); + + (match prim [String "erlang.OP_BIF_IS_TUPLE"] with + | Integer 239 -> + incr pass_count; + Printf.printf " PASS: extension-opcode-id erlang.OP_BIF_IS_TUPLE = 239\n" + | other -> + incr fail_count; + Printf.printf " FAIL: erlang.OP_BIF_IS_TUPLE: got %s\n" + (Sx_types.inspect other)); + + (match prim [String "erlang.OP_NONEXISTENT"] with + | Nil -> + incr pass_count; + Printf.printf " PASS: unknown erlang opcode -> nil\n" + | other -> + incr fail_count; + Printf.printf " FAIL: unknown erlang opcode: got %s\n" + (Sx_types.inspect other)); + + (* Dispatching an erlang opcode raises the not-wired Eval_error + (bytecode emission is a later phase; SX stub dispatcher is the + working path). 230 = erlang.OP_BIF_LENGTH. *) + (let globals = Hashtbl.create 1 in + try + ignore (Sx_vm.execute_module (make_bc_seq [| 230; 50 |]) globals); + incr fail_count; + Printf.printf " FAIL: erlang.OP_BIF_LENGTH dispatch should have raised\n" + with + | Sx_types.Eval_error msg + when (let needle = "not yet wired" in + let nl = String.length needle and ml = String.length msg in + let rec scan i = + if i + nl > ml then false + else if String.sub msg i nl = needle then true + else scan (i + 1) + in scan 0) -> + incr pass_count; + Printf.printf " PASS: erlang opcode dispatch raises not-wired error\n" + | exn -> + incr fail_count; + Printf.printf " FAIL: unexpected exn: %s\n" (Printexc.to_string exn)); + + (match Erlang_ext.dispatch_count () with + | Some n when n >= 1 -> + incr pass_count; + Printf.printf " PASS: erlang_ext state recorded %d dispatch(es)\n" n + | other -> + incr fail_count; + Printf.printf " FAIL: dispatch_count: %s\n" + (match other with Some n -> string_of_int n | None -> "None")); + Printf.printf "\nSuite: jit extension-opcode awareness\n"; let scan = Sx_vm.bytecode_uses_extension_opcodes in let no_consts = [||] in diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 5ef5298b..9d76c91f 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -26,6 +26,12 @@ open Sx_types invisible to the runtime. The applied call is a harmless lookup. *) let () = ignore (Sx_vm_extensions.id_of_name "") +(* Register the Erlang opcode extension (Phase 9h) so + `extension-opcode-id "erlang.OP_*"` resolves to the host ids the SX + stub dispatcher consults. Guarded: a double-register raises Failure, + which we swallow so a re-entered server process doesn't die. *) +let () = try Erlang_ext.register () with Failure _ -> () + (* ====================================================================== *) (* Font measurement via otfm — reads OpenType/TrueType font tables *) (* ====================================================================== *) diff --git a/hosts/ocaml/lib/extensions/erlang_ext.ml b/hosts/ocaml/lib/extensions/erlang_ext.ml new file mode 100644 index 00000000..e620ab6f --- /dev/null +++ b/hosts/ocaml/lib/extensions/erlang_ext.ml @@ -0,0 +1,99 @@ +(** {1 [erlang_ext] — Erlang-on-SX VM opcode extension (Phase 9h)} + + Registers the Erlang opcode namespace in [Sx_vm_extensions] so that + [extension-opcode-id "erlang.OP_*"] resolves to a stable id. The SX + stub dispatcher in [lib/erlang/vm/dispatcher.sx] consults these ids + (Phase 9i) and falls back to its own local ids when the host + extension is absent. + + Opcode ids occupy 222-239 in the extension partition (200-247). + 222+ is chosen to clear the test extensions' reserved ids + (test_reg 210/211, test_ext 220/221) so all three coexist in + run_tests; production sx_server only registers this one. Names + mirror the SX stub dispatcher exactly: + + - 222 erlang.OP_PATTERN_TUPLE - 231 erlang.OP_BIF_HD + - 223 erlang.OP_PATTERN_LIST - 232 erlang.OP_BIF_TL + - 224 erlang.OP_PATTERN_BINARY - 233 erlang.OP_BIF_ELEMENT + - 225 erlang.OP_PERFORM - 234 erlang.OP_BIF_TUPLE_SIZE + - 226 erlang.OP_HANDLE - 235 erlang.OP_BIF_LISTS_REVERSE + - 227 erlang.OP_RECEIVE_SCAN - 236 erlang.OP_BIF_IS_INTEGER + - 228 erlang.OP_SPAWN - 237 erlang.OP_BIF_IS_ATOM + - 229 erlang.OP_SEND - 238 erlang.OP_BIF_IS_LIST + - 230 erlang.OP_BIF_LENGTH - 239 erlang.OP_BIF_IS_TUPLE + + {2 Handler status} + + The bytecode compiler does not yet emit these opcodes — Erlang + programs run through the general CEK path and the working + specialization path is the SX stub dispatcher. So every handler + here raises a descriptive [Eval_error] rather than silently + corrupting the VM stack. This keeps the extension honest: the + namespace is registered and disassembles by name, [extension-opcode-id] + works, but actually dispatching an opcode (which only happens once a + future phase teaches the compiler to emit them) fails loudly with a + pointer to the phase that will wire it. Real stack-machine handlers + land alongside compiler emission in a later phase. *) + +open Sx_types + +(** Per-instance state: invocation counter, purely to exercise the + [extension_state] machinery (mirrors [test_ext]). *) +type Sx_vm_extension.extension_state += ErlangExtState of { + mutable dispatched : int; +} + +let not_wired name = + raise (Eval_error + (Printf.sprintf + "%s: bytecode emission not yet wired (Phase 9j) — \ + Erlang runs via CEK; specialization path is the SX stub \ + dispatcher in lib/erlang/vm/dispatcher.sx" + name)) + +module M : Sx_vm_extension.EXTENSION = struct + let name = "erlang" + let init () = ErlangExtState { dispatched = 0 } + + let opcodes st = + let bump () = match st with + | ErlangExtState s -> s.dispatched <- s.dispatched + 1 + | _ -> () + in + let op id nm = + (id, nm, (fun (_vm : Sx_vm.vm) (_frame : Sx_vm.frame) -> + bump (); not_wired nm)) + in + [ + op 222 "erlang.OP_PATTERN_TUPLE"; + op 223 "erlang.OP_PATTERN_LIST"; + op 224 "erlang.OP_PATTERN_BINARY"; + op 225 "erlang.OP_PERFORM"; + op 226 "erlang.OP_HANDLE"; + op 227 "erlang.OP_RECEIVE_SCAN"; + op 228 "erlang.OP_SPAWN"; + op 229 "erlang.OP_SEND"; + op 230 "erlang.OP_BIF_LENGTH"; + op 231 "erlang.OP_BIF_HD"; + op 232 "erlang.OP_BIF_TL"; + op 233 "erlang.OP_BIF_ELEMENT"; + op 234 "erlang.OP_BIF_TUPLE_SIZE"; + op 235 "erlang.OP_BIF_LISTS_REVERSE"; + op 236 "erlang.OP_BIF_IS_INTEGER"; + op 237 "erlang.OP_BIF_IS_ATOM"; + op 238 "erlang.OP_BIF_IS_LIST"; + op 239 "erlang.OP_BIF_IS_TUPLE"; + ] +end + +(** Register [erlang] in [Sx_vm_extensions]. Idempotent only by failing + loudly — calling twice raises [Failure]. sx_server calls this once + at startup. *) +let register () = Sx_vm_extensions.register (module M : Sx_vm_extension.EXTENSION) + +(** Read the dispatch counter from the live registry state. [None] if + [register] hasn't run. *) +let dispatch_count () = + match Sx_vm_extensions.state_of_extension "erlang" with + | Some (ErlangExtState s) -> Some s.dispatched + | _ -> None