;; Erlang VM — stub opcode dispatcher (Phase 9). ;; ;; Mimics the OCaml-side EXTENSION shape from ;; plans/sx-vm-opcode-extension.md so opcodes 9b-9g can be designed ;; and tested in SX before 9a (`hosts/ocaml/`) lands the real ;; registration plumbing. When 9a is available, these stubs become ;; the cross-host SX-side mirror of the C/OCaml handlers and the ;; bytecode compiler emits them directly. ;; ;; Opcode IDs follow the plan's tier partition: ;; 0-127 reserved for SX core ;; 128-199 guest extensions (e.g. erlang, lua) ;; 200-247 port-/platform-specific ;; ;; Erlang owns 128-159 for now. (define er-vm-opcodes (list {})) (define er-vm-opcodes-get (fn () (nth er-vm-opcodes 0))) (define er-vm-opcodes-reset! (fn () (set-nth! er-vm-opcodes 0 {}))) (define er-vm-register-opcode! (fn (id name handler) (dict-set! (er-vm-opcodes-get) (str id) {:name name :id id :handler handler}) (er-mk-atom "ok"))) (define er-vm-lookup-opcode-by-id (fn (id) (let ((reg (er-vm-opcodes-get)) (k (str id))) (if (dict-has? reg k) (get reg k) nil)))) (define er-vm-lookup-opcode-by-name (fn (name) (let ((reg (er-vm-opcodes-get)) (ks (keys (er-vm-opcodes-get))) (found (list nil))) (for-each (fn (i) (let ((entry (get reg (nth ks i)))) (when (= (get entry :name) name) (set-nth! found 0 entry)))) (range 0 (len ks))) (nth found 0)))) (define er-vm-list-opcodes (fn () (keys (er-vm-opcodes-get)))) ;; ── Phase 9i — host opcode-id resolution ──────────────────────── ;; When the OCaml `erlang_ext` extension is registered (Phase 9h), the ;; runtime exposes `extension-opcode-id` which maps an "erlang.OP_*" ;; name to the host-assigned id (222-239). We consult it so the SX ;; side and the OCaml side agree on ids; when it returns nil (name not ;; registered) we fall back to the stub-local id. ;; ;; NOTE: this requires a binary with the VM extension mechanism (the ;; vm-ext phase-A..E cherry-pick + Sx_vm_extensions force-link). The ;; loop builds and runs against exactly that binary ;; (hosts/ocaml/_build/default/bin/sx_server.exe). `extension-opcode-id` ;; resolves lazily at call time, so merely loading this file is safe; ;; only invoking the resolver on a binary that lacks the primitive ;; would raise. (define er-vm-host-opcode-id (fn (ext-name) (extension-opcode-id ext-name))) (define er-vm-effective-opcode-id (fn (ext-name stub-id) (let ((host (extension-opcode-id ext-name))) (cond (= host nil) stub-id :else host)))) (define er-vm-dispatch (fn (id operands) (let ((entry (er-vm-lookup-opcode-by-id id))) (if (= entry nil) (error (str "Erlang VM: unknown opcode id " id)) ((get entry :handler) operands))))) (define er-vm-dispatch-by-name (fn (name operands) (let ((entry (er-vm-lookup-opcode-by-name name))) (if (= entry nil) (error (str "Erlang VM: unknown opcode name '" name "'")) ((get entry :handler) operands))))) ;; ── Phase 9c — effect opcodes (perform / handle) ──────────────── ;; Stub algebraic-effects-style operators. OP_PERFORM raises a tagged ;; exception; OP_HANDLE wraps a thunk in `guard` and catches matching ;; effects, passing the args to the handler. The real specialization ;; (constant-time effect dispatch, single-shot vs multi-shot continuations) ;; lands when 9a integrates. (define er-vm-effect-marker? (fn (c effect-name) (and (= (type-of c) "dict") (= (get c :tag) "vm-effect") (= (get c :effect) effect-name)))) (define er-vm-op-perform (fn (operands) (raise {:tag "vm-effect" :effect (nth operands 0) :args (nth operands 1)}))) (define er-vm-op-handle (fn (operands) (let ((thunk (nth operands 0)) (effect-name (nth operands 1)) (handler (nth operands 2)) (result (list nil)) (caught (list false)) (rethrow (list nil))) (guard (c (:else (cond (er-vm-effect-marker? c effect-name) (do (set-nth! caught 0 true) (set-nth! result 0 (handler (get c :args)))) :else (set-nth! rethrow 0 c)))) (set-nth! result 0 (thunk))) (cond (not (= (nth rethrow 0) nil)) (raise (nth rethrow 0)) :else (nth result 0))))) ;; ── Phase 9d — receive scan opcode ──────────────────────────── ;; Selective receive primitive. Scans a mailbox value-list in arrival ;; order; for each value, tries each clause's pattern (binding into ;; env on success); on match returns `{:matched true :index N :body B}` ;; — the caller decides what to do with the index (queue-delete) and ;; the body (eval in the now-mutated env). On miss returns ;; `{:matched false}`, the caller arranges suspension (via OP_PERFORM). ;; ;; Operands: (clauses mbox-list env) ;; clauses — list of {:pattern :guards :body} dicts ;; mbox-list — SX list of message values ;; env — env dict (mutated on match) (define er-vm-receive-try-clauses (fn (clauses msg env i) (cond (>= i (len clauses)) {:matched false} :else (let ((c (nth clauses i)) (snap (er-env-copy env))) (cond (and (er-match! (get c :pattern) msg env) (er-eval-guards (get c :guards) env)) {:matched true :body (get c :body)} :else (do (er-env-restore! env snap) (er-vm-receive-try-clauses clauses msg env (+ i 1)))))))) (define er-vm-receive-scan-loop (fn (clauses mbox env i) (cond (>= i (len mbox)) {:matched false} :else (let ((msg (nth mbox i)) (cr (er-vm-receive-try-clauses clauses msg env 0))) (cond (get cr :matched) {:matched true :index i :body (get cr :body)} :else (er-vm-receive-scan-loop clauses mbox env (+ i 1))))))) (define er-vm-op-receive-scan (fn (operands) (er-vm-receive-scan-loop (nth operands 0) (nth operands 1) (nth operands 2) 0))) ;; ── Phase 9e — spawn / send + lightweight scheduler ───────────── ;; Stub register-machine process layout for the eventual fast scheduler. ;; A VM-process is `{:id :registers :mailbox :state :initial-fn :initial-args}`. ;; Registers is a vector (SX list, mutated via set-nth!) — fixed slot count ;; per process so cells don't grow during execution. Mailbox is an SX list. ;; State is one of "runnable" / "waiting" / "dead". This sits PARALLEL to ;; the existing `er-scheduler` (which is the language-level scheduler) — ;; the VM scheduler will eventually take over once 9a integrates and ;; bytecode-compiled Erlang runs against it. (define er-vm-procs (list {})) (define er-vm-procs-get (fn () (nth er-vm-procs 0))) (define er-vm-procs-reset! (fn () (do (set-nth! er-vm-procs 0 {}) (set-nth! er-vm-next-pid 0 0)))) (define er-vm-next-pid (list 0)) (define er-vm-proc-new! (fn (initial-fn initial-args) (let ((pid (nth er-vm-next-pid 0))) (set-nth! er-vm-next-pid 0 (+ pid 1)) (let ((proc {:id pid :registers (list nil nil nil nil nil nil nil nil) :mailbox (list) :state "runnable" :initial-fn initial-fn :initial-args initial-args})) (dict-set! (er-vm-procs-get) (str pid) proc) pid)))) (define er-vm-proc-get (fn (pid) (get (er-vm-procs-get) (str pid)))) (define er-vm-proc-send! (fn (pid msg) (let ((proc (er-vm-proc-get pid))) (cond (= proc nil) false :else (do (dict-set! proc :mailbox (append (get proc :mailbox) (list msg))) (when (= (get proc :state) "waiting") (dict-set! proc :state "runnable")) true))))) (define er-vm-proc-mailbox (fn (pid) (get (er-vm-proc-get pid) :mailbox))) (define er-vm-proc-state (fn (pid) (get (er-vm-proc-get pid) :state))) (define er-vm-proc-count (fn () (len (keys (er-vm-procs-get))))) (define er-vm-op-spawn (fn (operands) (er-vm-proc-new! (nth operands 0) (nth operands 1)))) (define er-vm-op-send (fn (operands) (er-vm-proc-send! (nth operands 0) (nth operands 1)))) ;; ── Phase 9f — hot-BIF dispatch table ────────────────────────── ;; Specialized opcodes for the BIFs that the bytecode compiler emits ;; on hot call sites. The handler is the underlying `er-bif-*` impl ;; directly — same `(vs)` signature as the dispatcher uses for ;; operands, so the cost is the opcode-id → handler hop with no ;; registry-key string lookup. Cold BIFs continue going through the ;; general path (`er-apply-bif` / `er-lookup-bif`). ;; ;; Opcodes 136-159 reserved for hot BIFs. ;; ── Phase 9b — pattern-match opcodes ──────────────────────────── ;; Each handler takes a list (pattern-ast value env) and returns ;; true/false, mutating env on success (same contract as the ;; existing er-match-tuple / er-match-cons / er-match-binary). ;; Wire these as wrappers for now; the real opcodes will eventually ;; have register-machine semantics and skip the AST-walk overhead. (define er-vm-register-erlang-opcodes! (fn () (er-vm-register-opcode! 128 "OP_PATTERN_TUPLE" (fn (operands) (er-match-tuple (nth operands 0) (nth operands 1) (nth operands 2)))) (er-vm-register-opcode! 129 "OP_PATTERN_LIST" (fn (operands) (er-match-cons (nth operands 0) (nth operands 1) (nth operands 2)))) (er-vm-register-opcode! 130 "OP_PATTERN_BINARY" (fn (operands) (er-match-binary (nth operands 0) (nth operands 1) (nth operands 2)))) (er-vm-register-opcode! 131 "OP_PERFORM" er-vm-op-perform) (er-vm-register-opcode! 132 "OP_HANDLE" er-vm-op-handle) (er-vm-register-opcode! 133 "OP_RECEIVE_SCAN" er-vm-op-receive-scan) (er-vm-register-opcode! 134 "OP_SPAWN" er-vm-op-spawn) (er-vm-register-opcode! 135 "OP_SEND" er-vm-op-send) ;; Phase 9f — hot BIFs (er-vm-register-opcode! 136 "OP_BIF_LENGTH" er-bif-length) (er-vm-register-opcode! 137 "OP_BIF_HD" er-bif-hd) (er-vm-register-opcode! 138 "OP_BIF_TL" er-bif-tl) (er-vm-register-opcode! 139 "OP_BIF_ELEMENT" er-bif-element) (er-vm-register-opcode! 140 "OP_BIF_TUPLE_SIZE" er-bif-tuple-size) (er-vm-register-opcode! 141 "OP_BIF_LISTS_REVERSE" er-bif-lists-reverse) (er-vm-register-opcode! 142 "OP_BIF_IS_INTEGER" er-bif-is-integer) (er-vm-register-opcode! 143 "OP_BIF_IS_ATOM" er-bif-is-atom) (er-vm-register-opcode! 144 "OP_BIF_IS_LIST" er-bif-is-list) (er-vm-register-opcode! 145 "OP_BIF_IS_TUPLE" er-bif-is-tuple) (er-mk-atom "ok"))) (er-vm-register-erlang-opcodes!)