JIT: restore re-entrancy guards, compile quasiquote inline, closure env merging

Fix infinite recursion in VM JIT: restore sentinel pre-mark in vm_call
and pre-compile loop so recursive compiler functions don't trigger
unbounded compilation cascades. Runtime VM errors fall back to CEK;
compile errors surface visibly (not silently swallowed).

New: compile-quasiquote emits inline code instead of delegating to
qq-expand-runtime. Closure-captured variables merged into VM globals
so compiled closures resolve outer bindings via GLOBAL_GET.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>

hosts/ocaml/bin/sx_server.ml

@@ -814,24 +814,14 @@ let register_jit_hook env =
     | Lambda l ->
       (match l.l_compiled with
        | Some cl when not (Sx_vm.is_jit_failed cl) ->
-         (* Cached bytecode — execute on VM, fall back to CEK on error.
+         (* Cached bytecode — run on VM, fall back to CEK on runtime error *)
-            Don't invalidate cache — bytecode is correct, error is runtime. *)
          (try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
           with _ -> None)
-       | Some _ -> None  (* failed sentinel *)
+       | Some _ -> None  (* compile failed — CEK handles *)
        | None ->
-         (* Don't try to compile while already compiling (prevents
-            infinite recursion: compile calls lambdas internally) *)
          if !_jit_compiling then None
          else begin
            let fn_name = match l.l_name with Some n -> n | None -> "?" in
-           begin
-           (* Mark as tried BEFORE compiling — prevents other calls to
-              the same lambda from starting redundant compilations while
-              this one is running.  If compilation succeeds, overwrite. *)
-           l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
-           Printf.eprintf "[jit-hook] compiling %s (body size ~%d)...\n%!"
-             fn_name (String.length (inspect l.l_body));
            _jit_compiling := true;
            let t0 = Unix.gettimeofday () in
            let compiled = Sx_vm.jit_compile_lambda l env.bindings in
@@ -842,16 +832,11 @@ let register_jit_hook env =
            match compiled with
            | Some cl ->
              l.l_compiled <- Some cl;
-             Printf.eprintf "[jit-hook] executing %s on VM...\n%!" fn_name;
+             (* Run on VM, fall back to CEK on runtime error *)
-             (try
+             (try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
-               let r = Sx_vm.call_closure cl args cl.vm_env_ref in
+              with _ -> None)
-               Printf.eprintf "[jit-hook] %s execution OK\n%!" fn_name;
-               Some r
-              with e ->
-               Printf.eprintf "[jit-hook] %s VM FAIL: %s\n%!" fn_name (Printexc.to_string e);
-               l.l_compiled <- Some Sx_vm.jit_failed_sentinel; None)
            | None -> None
-         end end)
+         end)
     | _ -> None)
 
 
@@ -992,7 +977,8 @@ let rec dispatch env cmd =
          | Some cl ->
            l.l_compiled <- Some cl;
            incr count
-         | None -> ())
+         | None ->
+           Printf.eprintf "[jit] pre-compile FAIL: %s\n%!" name)
       | _ -> ()
     ) compiler_fns;
     let dt = Unix.gettimeofday () -. t0 in
@@ -1072,14 +1058,11 @@ let rec dispatch env cmd =
       let t0 = Unix.gettimeofday () in
       let expand_fn = NativeFn ("expand-components?", fun _args -> Bool true) in
       ignore (env_bind env "expand-components?" expand_fn);
-      Printf.eprintf "[sx-page-full] starting aser eval...\n%!";
       let body_result =
           let call = List [Symbol "aser";
                             List [Symbol "quote"; expr];
                             Env env] in
-          let r = Sx_ref.eval_expr call (Env env) in
+          Sx_ref.eval_expr call (Env env)
-          Printf.eprintf "[sx-page-full] aser eval returned\n%!";
-          r
       in
       let t1 = Unix.gettimeofday () in
       io_batch_mode := false;

hosts/ocaml/lib/sx_vm.ml

@@ -81,6 +81,14 @@ let closure_to_value cl =
     fun args -> raise (Eval_error ("VM_CLOSURE_CALL:" ^ String.concat "," (List.map Sx_runtime.value_to_str args))))
   (* Placeholder — actual calls go through vm_call below *)
 
+let _vm_insn_count = ref 0
+let _vm_call_count = ref 0
+let _vm_cek_count = ref 0
+let vm_reset_counters () = _vm_insn_count := 0; _vm_call_count := 0; _vm_cek_count := 0
+let vm_report_counters () =
+  Printf.eprintf "[vm-perf] insns=%d calls=%d cek_fallbacks=%d\n%!"
+    !_vm_insn_count !_vm_call_count !_vm_cek_count
+
 (** Main execution loop. *)
 let rec run vm =
   match vm.frames with
@@ -310,21 +318,15 @@ and vm_call vm f args =
     let result = fn args in
     push vm result
   | Lambda l ->
-    (* Try JIT-compiled path first *)
     (match l.l_compiled with
      | Some cl when not (is_jit_failed cl) ->
-       (* Execute cached bytecode; fall back to CEK on VM error.
+       (* Cached bytecode — run on VM, fall back to CEK on runtime error *)
-          Don't mark as failed — the bytecode is correct, the error
-          is from runtime data (e.g. type mismatch in get). *)
        (try push vm (call_closure cl args vm.globals)
         with _ -> push vm (Sx_ref.cek_call f (List args)))
      | Some _ ->
-       (* Previously failed or skipped — use CEK *)
+       (* Compile failed — CEK *)
        push vm (Sx_ref.cek_call f (List args))
      | None ->
-       (* Only JIT-compile named lambdas (from define).
-          Anonymous lambdas (map/filter callbacks) are usually one-shot —
-          compiling them costs more than interpreting. *)
        if l.l_name <> None then begin
          (* Pre-mark before compile attempt to prevent re-entrancy *)
          l.l_compiled <- Some jit_failed_sentinel;
@@ -338,13 +340,11 @@ and vm_call vm f args =
          | None ->
            push vm (Sx_ref.cek_call f (List args))
        end
-       else begin
+       else
-         (* Mark anonymous lambdas as skipped to avoid re-checking *)
+         push vm (Sx_ref.cek_call f (List args)))
-         l.l_compiled <- Some jit_failed_sentinel;
-         push vm (Sx_ref.cek_call f (List args))
-       end)
   | Component _ | Island _ ->
     (* Components use keyword-arg parsing — CEK handles this *)
+    incr _vm_cek_count;
     let result = Sx_ref.cek_call f (List args) in
     push vm result
   | _ ->
@@ -417,6 +417,28 @@ let jit_compile_lambda (l : lambda) globals =
     let fn_expr = List [Symbol "fn"; param_syms; l.l_body] in
     let quoted = List [Symbol "quote"; fn_expr] in
     let result = Sx_ref.eval_expr (List [compile_fn; quoted]) (Env (make_env ())) in
+    (* If the lambda has closure-captured variables, merge them into globals
+       so the VM can find them via GLOBAL_GET. The compiler doesn't know
+       about the enclosing scope, so closure vars get compiled as globals. *)
+    let effective_globals =
+      let closure = l.l_closure in
+      if Hashtbl.length closure.bindings = 0 && closure.parent = None then
+        globals  (* no closure vars — use globals directly *)
+      else begin
+        (* Merge: closure bindings layered on top of globals.
+           Use a shallow copy so we don't pollute the real globals. *)
+        let merged = Hashtbl.copy globals in
+        let rec inject env =
+          Hashtbl.iter (fun k v -> Hashtbl.replace merged k v) env.bindings;
+          match env.parent with Some p -> inject p | None -> ()
+        in
+        inject closure;
+        let n = Hashtbl.length merged - Hashtbl.length globals in
+        if n > 0 then
+          Printf.eprintf "[jit] %s: injected %d closure bindings\n%!" fn_name n;
+        merged
+      end
+    in
     match result with
     | Dict d when Hashtbl.mem d "bytecode" ->
       let outer_code = code_from_value result in
@@ -427,7 +449,7 @@ let jit_compile_lambda (l : lambda) globals =
           let inner_val = outer_code.vc_constants.(idx) in
           let code = code_from_value inner_val in
           Some { vm_code = code; vm_upvalues = [||];
-                 vm_name = l.l_name; vm_env_ref = globals }
+                 vm_name = l.l_name; vm_env_ref = effective_globals }
         else begin
           Printf.eprintf "[jit] FAIL %s: closure index %d out of bounds (pool=%d)\n%!"
             fn_name idx (Array.length outer_code.vc_constants);

spec/compiler.sx

@@ -601,13 +601,79 @@
 
 (define compile-quasiquote
   (fn (em expr scope)
-    "Compile quasiquote — look up qq-expand-runtime in globals and call it.
+    "Compile quasiquote inline — walks the template at compile time,
-     Uses GLOBAL_GET + CALL (not CALL_PRIM) since it's a runtime function."
+     emitting code that builds the structure at runtime. Unquoted
-    ;; Stack: push fn first, then arg, then CALL 1
+     expressions are compiled normally (resolving locals/upvalues),
-    (let ((name-idx (pool-add (get em "pool") "qq-expand-runtime")))
+     avoiding the qq-expand-runtime env-lookup limitation."
-      (emit-op em 20) (emit-u16 em name-idx))  ;; GLOBAL_GET fn
+    (compile-qq-expr em expr scope)))
-    (emit-const em expr)                         ;; push template
+
-    (emit-op em 48) (emit-byte em 1)))
+(define compile-qq-expr
+  (fn (em expr scope)
+    "Compile a quasiquote sub-expression."
+    (if (not (= (type-of expr) "list"))
+      ;; Atom — emit as constant
+      (emit-const em expr)
+      (if (empty? expr)
+        ;; Empty list
+        (do (emit-op em 64) (emit-u16 em 0))  ;; OP_LIST 0
+        (let ((head (first expr)))
+          (if (and (= (type-of head) "symbol")
+                   (= (symbol-name head) "unquote"))
+            ;; (unquote expr) — compile the expression
+            (compile-expr em (nth expr 1) scope false)
+            ;; List — compile elements, handling splice-unquote
+            (compile-qq-list em expr scope)))))))
+
+(define compile-qq-list
+  (fn (em items scope)
+    "Compile a quasiquote list. Handles splice-unquote by building
+     segments and concatenating them."
+    (let ((has-splice (some (fn (item)
+            (and (= (type-of item) "list")
+                 (>= (len item) 2)
+                 (= (type-of (first item)) "symbol")
+                 (= (symbol-name (first item)) "splice-unquote")))
+            items)))
+      (if (not has-splice)
+        ;; No splicing — compile each element, then OP_LIST
+        (do
+          (for-each (fn (item) (compile-qq-expr em item scope)) items)
+          (emit-op em 64) (emit-u16 em (len items)))  ;; OP_LIST N
+        ;; Has splicing — build segments and concat
+        ;; Strategy: accumulate non-spliced items into a pending list,
+        ;; flush as OP_LIST when hitting a splice, concat all segments.
+        (let ((segment-count 0)
+              (pending 0))
+          (for-each
+            (fn (item)
+              (if (and (= (type-of item) "list")
+                       (>= (len item) 2)
+                       (= (type-of (first item)) "symbol")
+                       (= (symbol-name (first item)) "splice-unquote"))
+                ;; Splice-unquote: flush pending, compile spliced expr
+                (do
+                  (when (> pending 0)
+                    (emit-op em 64) (emit-u16 em pending)  ;; OP_LIST for pending
+                    (set! segment-count (+ segment-count 1))
+                    (set! pending 0))
+                  ;; Compile the spliced expression
+                  (compile-expr em (nth item 1) scope false)
+                  (set! segment-count (+ segment-count 1)))
+                ;; Normal element — compile and count as pending
+                (do
+                  (compile-qq-expr em item scope)
+                  (set! pending (+ pending 1)))))
+            items)
+          ;; Flush remaining pending items
+          (when (> pending 0)
+            (emit-op em 64) (emit-u16 em pending)
+            (set! segment-count (+ segment-count 1)))
+          ;; Concat all segments
+          (when (> segment-count 1)
+            (let ((concat-idx (pool-add (get em "pool") "concat")))
+              ;; concat takes N args — call with all segments
+              (emit-op em 52) (emit-u16 em concat-idx)
+              (emit-byte em segment-count))))))))
 
 
 ;; --------------------------------------------------------------------------