VM aser-slot routing: isolated globals, inner code extraction, debug

aser-slot now routes through the VM when adapter is compiled:
- compile_adapter: compiles each define body, extracts inner code
  from OP_CLOSURE wrapper, stores as NativeFn in separate globals
- vm_adapter_globals: isolated from kernel env (no cross-contamination)
- aser-slot checks vm_adapter_globals, calls VM aser directly

Status: 2/12 adapter functions compile and run on VM. 6 fail during
OCaml-side compilation with "index out of bounds" — likely from
set-nth! silent failure on ListRef during bytecode jump patching.

Debug output shows outer code structure is correct (4 bytes, 1 const).
Inner code_from_value conversion needs fixing for nested closures.

Also: vm-compile-adapter command inside _ensure_components lock
(fixes pipe desync from concurrent requests).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-19 22:18:21 +00:00
parent df256b5607
commit 231bfbecb5
3 changed files with 163 additions and 27 deletions

View File

@@ -95,14 +95,18 @@ let rec run vm =
| frame :: rest_frames ->
let bc = frame.closure.code.bytecode in
let consts = frame.closure.code.constants in
if frame.ip >= Array.length bc then () (* ran off end *)
if frame.ip >= Array.length bc then ()
else
let saved_ip = frame.ip in
let op = bc.(frame.ip) in
frame.ip <- frame.ip + 1;
match op with
(try match op with
(* ---- Constants ---- *)
| 1 (* OP_CONST *) ->
let idx = read_u16 frame in
if idx >= Array.length consts then
raise (Eval_error (Printf.sprintf "VM: CONST index %d out of bounds (pool size %d)"
idx (Array.length consts)));
push vm consts.(idx);
run vm
| 2 (* OP_NIL *) -> push vm Nil; run vm
@@ -114,10 +118,14 @@ let rec run vm =
(* ---- Variable access ---- *)
| 16 (* OP_LOCAL_GET *) ->
let slot = read_u8 frame in
(* Check if this local is captured — read from shared cell *)
let v = match Hashtbl.find_opt frame.local_cells slot with
| Some cell -> cell.uv_value
| None -> vm.stack.(frame.base + slot)
| None ->
let idx = frame.base + slot in
if idx >= vm.sp then
raise (Eval_error (Printf.sprintf
"VM: LOCAL_GET slot=%d base=%d sp=%d out of bounds" slot frame.base vm.sp));
vm.stack.(idx)
in
push vm v;
run vm
@@ -131,6 +139,10 @@ let rec run vm =
run vm
| 18 (* OP_UPVALUE_GET *) ->
let idx = read_u8 frame in
if idx >= Array.length frame.closure.upvalues then
raise (Eval_error (Printf.sprintf
"VM: UPVALUE_GET idx=%d out of bounds (have %d)" idx
(Array.length frame.closure.upvalues)));
push vm frame.closure.upvalues.(idx).uv_value;
run vm
| 19 (* OP_UPVALUE_SET *) ->
@@ -279,9 +291,14 @@ let rec run vm =
run vm
| opcode ->
(* Unknown opcode — fall back to CEK machine *)
raise (Eval_error (Printf.sprintf "VM: unknown opcode %d at ip=%d"
opcode (frame.ip - 1)))
with Invalid_argument msg ->
let fn_name = match frame.closure.name with Some n -> n | None -> "?" in
raise (Eval_error (Printf.sprintf
"VM: %s at ip=%d op=%d in %s (base=%d sp=%d bc_len=%d consts=%d)"
msg saved_ip op fn_name frame.base vm.sp
(Array.length bc) (Array.length consts))))
(** Call a value as a function — dispatch by type. *)
and vm_call vm f args =