vm.sx feature parity: JIT dispatch, active VM tracking, CEK fallback

Add missing features to lib/vm.sx that sx_vm.ml has:
- *active-vm* mutable global for HO primitive callback VM reuse
- *jit-compile-fn* platform-settable JIT compilation hook
- try-jit-call: check lambda-compiled, attempt JIT, fallback to CEK
- vm-call: VmClosure→push-frame, Lambda→try-jit, Component→CEK
- vm-call-closure: save/restore *active-vm* around execution
- vm-push-frame: refactored to use accessor functions
- cek-call-or-suspend: preamble-provided CEK interop

Transpiled output (sx_vm_ref.ml) now has 12 functions (was 9):
  *active-vm*, *jit-compile-fn*, try-jit-call, vm-call,
  vm-resolve-ho-form, vm-call-external, env-walk, env-walk-set!,
  vm-run, vm-step, vm-call-closure, vm-execute-module

48 preamble functions (native OCaml type access).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-04 13:00:07 +00:00
parent df89d8249b
commit cd61c049e3
6 changed files with 129 additions and 63 deletions

File diff suppressed because one or more lines are too long

View File

@@ -19,6 +19,14 @@
vm-push-frame
code-from-value
vm-closure?
*active-vm*
*jit-compile-fn*
lambda?
lambda-compiled
lambda-set-compiled!
lambda-name
cek-call-or-suspend
try-jit-call
vm-call
frame-local-get
frame-local-set
@@ -42,8 +50,8 @@
vm-set-frames!
vm-globals-ref
collect-n-from-stack
pad-n-nils
collect-n-pairs
pad-n-nils
vm-global-get
vm-resolve-ho-form
vm-call-external
@@ -118,28 +126,12 @@
(fn
(vm closure args)
(let
((frame (make-vm-frame closure (get vm "sp"))))
((frame (make-vm-frame closure (vm-sp vm))))
(for-each (fn (a) (vm-push vm a)) args)
(let
((arity (len args))
(total-locals (get (get closure "vm-code") "vc-locals")))
(let
((pad-count (- total-locals arity)))
(when
(> pad-count 0)
(let
((i 0))
(define
pad-loop
(fn
()
(when
(< i pad-count)
(vm-push vm nil)
(set! i (+ i 1))
(pad-loop))))
(pad-loop)))))
(dict-set! vm "frames" (cons frame (get vm "frames"))))))
(pad-n-nils
vm
(- (code-locals (closure-code closure)) (len args)))
(vm-set-frames! vm (cons frame (vm-frames vm))))))
(define
code-from-value
(fn
@@ -157,6 +149,38 @@
(arity (if (nil? arity-raw) 0 arity-raw)))
(make-vm-code arity (+ arity 16) bc consts)))))
(define vm-closure? (fn (v) (and (dict? v) (has-key? v "vm-code"))))
(define *active-vm* nil)
(define *jit-compile-fn* nil)
(define lambda? (fn (v) (= (type-of v) "lambda")))
(define lambda-compiled (fn (f) nil))
(define lambda-set-compiled! (fn (f val) nil))
(define lambda-name (fn (f) nil))
(define cek-call-or-suspend (fn (vm f args) (cek-call f args)))
(define
try-jit-call
(fn
(vm f args)
(let
((compiled (lambda-compiled f)))
(cond
(vm-closure? compiled)
(vm-push vm (vm-call-closure compiled args (vm-globals-ref vm)))
(= compiled :jit-failed)
(vm-push vm (cek-call-or-suspend vm f args))
(and *jit-compile-fn* (lambda-name f))
(do
(lambda-set-compiled! f :jit-failed)
(let
((result (*jit-compile-fn* f (vm-globals-ref vm))))
(if
(vm-closure? result)
(do
(lambda-set-compiled! f result)
(vm-push
vm
(vm-call-closure result args (vm-globals-ref vm))))
(vm-push vm (cek-call-or-suspend vm f args)))))
:else (vm-push vm (cek-call-or-suspend vm f args))))))
(define
vm-call
(fn
@@ -164,11 +188,10 @@
(cond
(vm-closure? f)
(vm-push-frame vm f args)
(or
(= (type-of f) "lambda")
(= (type-of f) "component")
(= (type-of f) "island"))
(vm-push vm (cek-call f args))
(lambda? f)
(try-jit-call vm f args)
(or (= (type-of f) "component") (= (type-of f) "island"))
(vm-push vm (cek-call-or-suspend vm f args))
(callable? f)
(vm-push vm (apply f args))
:else (error (str "VM: not callable: " (type-of f))))))
@@ -580,9 +603,11 @@
(fn
(closure args globals)
(let
((vm (make-vm globals)))
((prev-vm *active-vm*) (vm (make-vm globals)))
(set! *active-vm* vm)
(vm-push-frame vm closure args)
(vm-run vm)
(set! *active-vm* prev-vm)
(vm-pop vm))))
(define
vm-execute-module

File diff suppressed because one or more lines are too long