100 lines
3.9 KiB
OCaml
100 lines
3.9 KiB
OCaml
(** {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
|