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>

hosts/ocaml/bin/sx_server.ml

@@ -647,6 +647,101 @@ let make_server_env () =
   env
 
 
+(* ====================================================================== *)
+(* VM adapter — compiled aser functions in isolated globals                 *)
+(* ====================================================================== *)
+
+(** Compiled adapter globals — separate from kernel env.
+    Contains compiled aser functions + reads from kernel env for
+    components, helpers, and other runtime bindings. *)
+let vm_adapter_globals : (string, value) Hashtbl.t option ref = ref None
+
+(** Compile adapter-sx.sx and store in vm_adapter_globals.
+    Called from vm-compile-adapter command. *)
+let compile_adapter env =
+  if not (Hashtbl.mem env.bindings "compile") then
+    raise (Eval_error "compiler not loaded")
+  else begin
+    let compile_fn = Hashtbl.find env.bindings "compile" in
+    (* Find and parse adapter-sx.sx *)
+    let web_dir = try Sys.getenv "SX_WEB_DIR" with Not_found ->
+      try Filename.concat (Sys.getenv "SX_SPEC_DIR") "../web"
+      with Not_found -> "web" in
+    let adapter_path = Filename.concat web_dir "adapter-sx.sx" in
+    if not (Sys.file_exists adapter_path) then
+      raise (Eval_error ("adapter-sx.sx not found: " ^ adapter_path));
+    let exprs = Sx_parser.parse_file adapter_path in
+    (* Compile each define's body *)
+    let globals = Hashtbl.create 64 in
+    (* Seed with kernel env for component/helper lookups *)
+    Hashtbl.iter (fun k v -> Hashtbl.replace globals k v) env.bindings;
+    let compiled = ref 0 in
+    List.iter (fun expr ->
+      match expr with
+      | List (Symbol "define" :: Symbol name :: rest) ->
+        (* Find the body — skip :effects annotations *)
+        let rec find_body = function
+          | Keyword _ :: _ :: rest -> find_body rest
+          | body :: _ -> body
+          | [] -> Nil
+        in
+        let body = find_body rest in
+        (try
+          let quoted = List [Symbol "quote"; body] in
+          let result = Sx_ref.eval_expr (List [compile_fn; quoted]) (Env env) in
+          match result with
+          | Dict d when Hashtbl.mem d "bytecode" ->
+            let outer_code = Sx_vm.code_from_value result in
+            Printf.eprintf "[vm] %s: outer bc=%d consts=%d inner_type=%s\n%!"
+              name (Array.length outer_code.Sx_vm.bytecode)
+              (Array.length outer_code.Sx_vm.constants)
+              (if Array.length outer_code.Sx_vm.constants > 0 then
+                type_of outer_code.Sx_vm.constants.(0) else "empty");
+            (* The compiled define body is (fn ...) which compiles to
+               OP_CLOSURE + [upvalue descriptors] + OP_RETURN.
+               Extract the inner code object from constants[idx]. *)
+            let code =
+              let bc = outer_code.Sx_vm.bytecode in
+              if Array.length bc >= 4 && bc.(0) = 51 then begin
+                let idx = bc.(1) lor (bc.(2) lsl 8) in
+                if idx < Array.length outer_code.Sx_vm.constants then begin
+                  let inner_val = outer_code.Sx_vm.constants.(idx) in
+                  try Sx_vm.code_from_value inner_val
+                  with e ->
+                    Printf.eprintf "[vm] inner code_from_value failed for %s: %s\n%!"
+                      name (Printexc.to_string e);
+                    Printf.eprintf "[vm]   inner val type: %s\n%!" (type_of inner_val);
+                    (match inner_val with
+                     | Dict d ->
+                       Printf.eprintf "[vm]   inner keys: %s\n%!"
+                         (String.concat ", " (Hashtbl.fold (fun k _ acc -> k::acc) d []));
+                       (match Hashtbl.find_opt d "bytecode" with
+                        | Some v -> Printf.eprintf "[vm]   bytecode type: %s\n%!" (type_of v)
+                        | None -> Printf.eprintf "[vm]   NO bytecode key\n%!")
+                     | _ -> ());
+                    raise e
+                end else outer_code
+              end else outer_code
+            in
+            let cl = { Sx_vm.code; upvalues = [||]; name = Some name;
+                        env_ref = globals } in
+            Hashtbl.replace globals name
+              (NativeFn ("vm:" ^ name, fun args ->
+                Sx_vm.call_closure cl args globals));
+            incr compiled
+          | _ -> ()  (* non-dict result — skip *)
+        with e ->
+          Printf.eprintf "[vm] FAIL adapter %s: %s\n%!" name (Printexc.to_string e))
+
+      | _ ->
+        (* Non-define expression — evaluate on CEK to set up constants *)
+        (try ignore (Sx_ref.eval_expr expr (Env env)) with _ -> ())
+    ) exprs;
+    vm_adapter_globals := Some globals;
+    Printf.eprintf "[vm] Compiled adapter: %d functions\n%!" !compiled
+  end
+
+
 (* ====================================================================== *)
 (* Command dispatch                                                        *)
 (* ====================================================================== *)
@@ -743,25 +838,53 @@ let dispatch env cmd =
     | Eval_error msg -> send_error msg
     | exn -> send_error (Printexc.to_string exn))
 
-  | List [Symbol "aser-slot"; String src] ->
+  | List [Symbol "vm-compile-adapter"] ->
-    (* Expand ALL components server-side. Uses batch IO mode for
+    (* Compile adapter-sx.sx to VM bytecode with isolated globals *)
-       concurrent highlight calls. Tries VM first, falls back to CEK. *)
+    (try
+      compile_adapter env;
+      send_ok ()
+    with
+    | Eval_error msg -> send_error msg
+    | exn -> send_error (Printexc.to_string exn))
+
+  | List [Symbol "aser-slot"; String src] ->
+    (* Expand ALL components server-side. Uses batch IO mode.
+       Routes through VM if adapter is compiled, else CEK. *)
     (try
-      ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
-      io_batch_mode := true;
-      io_queue := [];
-      io_counter := 0;
       let exprs = Sx_parser.parse_all src in
       let expr = match exprs with
         | [e] -> e
         | [] -> Nil
         | _ -> List (Symbol "<>" :: exprs)
       in
-      let call = List [Symbol "aser";
+      io_batch_mode := true;
-                        List [Symbol "quote"; expr];
+      io_queue := [];
-                        Env env] in
+      io_counter := 0;
       let t0 = Unix.gettimeofday () in
-      let result = Sx_ref.eval_expr call (Env env) in
+      let result = match !vm_adapter_globals with
+        | Some globals ->
+          (* VM path: call compiled aser directly *)
+          Hashtbl.replace globals "expand-components?"
+            (NativeFn ("expand-components?", fun _args -> Bool true));
+          let aser_fn = try Hashtbl.find globals "aser"
+            with Not_found -> raise (Eval_error "VM: aser not compiled") in
+          let r = match aser_fn with
+            | NativeFn (_, fn) -> fn [expr; Env env]
+            | _ -> raise (Eval_error "VM: aser not a function")
+          in
+          Hashtbl.remove globals "expand-components?";
+          r
+        | None ->
+          (* CEK fallback *)
+          ignore (env_bind env "expand-components?"
+            (NativeFn ("expand-components?", fun _args -> Bool true)));
+          let call = List [Symbol "aser";
+                            List [Symbol "quote"; expr];
+                            Env env] in
+          let r = Sx_ref.eval_expr call (Env env) in
+          Hashtbl.remove env.bindings "expand-components?";
+          r
+      in
       let t1 = Unix.gettimeofday () in
       io_batch_mode := false;
       Hashtbl.remove env.bindings "expand-components?";

hosts/ocaml/lib/sx_vm.ml

@@ -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 =

shared/sx/ocaml_bridge.py

@@ -330,19 +330,15 @@ class OcamlBridge:
                         skipped += 1
                         _logger.warning("OCaml load skipped %s: %s",
                                         filepath, e)
+                # Compile adapter to VM after all files loaded (inside lock)
+                try:
+                    await self._send('(vm-compile-adapter)')
+                    await self._read_until_ok(ctx=None)
+                    _logger.info("VM adapter compiled — aser runs on bytecode VM")
+                except OcamlBridgeError as e:
+                    _logger.warning("VM adapter compilation skipped: %s", e)
             _logger.info("Loaded %d definitions from .sx files into OCaml kernel (%d skipped)",
                          count, skipped)
-
-            # VM adapter compilation: compile adapter-sx.sx to bytecode,
-            # load as VM module so aser runs compiled.
-            # DISABLED: vm-load-module replaces env bindings with NativeFn
-            # wrappers that break when the CEK machine calls other env
-            # functions during page eval. Need to isolate VM execution
-            # from CEK env to avoid cross-contamination.
-            # try:
-            #     await self._compile_adapter_module()
-            # except Exception as e:
-            #     _logger.warning("VM adapter compilation skipped: %s", e)
         except Exception as e:
             _logger.error("Failed to load .sx files into OCaml kernel: %s", e)
             self._components_loaded = False  # retry next time