From 231bfbecb565804f5493129068c648ade129bfed Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 19 Mar 2026 22:18:21 +0000 Subject: [PATCH] VM aser-slot routing: isolated globals, inner code extraction, debug MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/bin/sx_server.ml | 145 ++++++++++++++++++++++++++++++++--- hosts/ocaml/lib/sx_vm.ml | 27 +++++-- shared/sx/ocaml_bridge.py | 18 ++--- 3 files changed, 163 insertions(+), 27 deletions(-) diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index ecb806e..8f5d5e3 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/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] -> - (* Expand ALL components server-side. Uses batch IO mode for - concurrent highlight calls. Tries VM first, falls back to CEK. *) + | List [Symbol "vm-compile-adapter"] -> + (* Compile adapter-sx.sx to VM bytecode with isolated globals *) + (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"; - List [Symbol "quote"; expr]; - Env env] in + io_batch_mode := true; + io_queue := []; + 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?"; diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index d6a99a4..1b04122 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/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 = diff --git a/shared/sx/ocaml_bridge.py b/shared/sx/ocaml_bridge.py index 517ed11..c31a7d2 100644 --- a/shared/sx/ocaml_bridge.py +++ b/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